{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.AppMesh.Types.RouteSpec
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.AppMesh.Types.RouteSpec where

import Amazonka.AppMesh.Types.GrpcRoute
import Amazonka.AppMesh.Types.HttpRoute
import Amazonka.AppMesh.Types.TcpRoute
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

-- | An object that represents a route specification. Specify one route type.
--
-- /See:/ 'newRouteSpec' smart constructor.
data RouteSpec = RouteSpec'
  { -- | An object that represents the specification of a gRPC route.
    RouteSpec -> Maybe GrpcRoute
grpcRoute :: Prelude.Maybe GrpcRoute,
    -- | An object that represents the specification of an HTTP\/2 route.
    RouteSpec -> Maybe HttpRoute
http2Route :: Prelude.Maybe HttpRoute,
    -- | An object that represents the specification of an HTTP route.
    RouteSpec -> Maybe HttpRoute
httpRoute :: Prelude.Maybe HttpRoute,
    -- | The priority for the route. Routes are matched based on the specified
    -- value, where 0 is the highest priority.
    RouteSpec -> Maybe Natural
priority :: Prelude.Maybe Prelude.Natural,
    -- | An object that represents the specification of a TCP route.
    RouteSpec -> Maybe TcpRoute
tcpRoute :: Prelude.Maybe TcpRoute
  }
  deriving (RouteSpec -> RouteSpec -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RouteSpec -> RouteSpec -> Bool
$c/= :: RouteSpec -> RouteSpec -> Bool
== :: RouteSpec -> RouteSpec -> Bool
$c== :: RouteSpec -> RouteSpec -> Bool
Prelude.Eq, ReadPrec [RouteSpec]
ReadPrec RouteSpec
Int -> ReadS RouteSpec
ReadS [RouteSpec]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RouteSpec]
$creadListPrec :: ReadPrec [RouteSpec]
readPrec :: ReadPrec RouteSpec
$creadPrec :: ReadPrec RouteSpec
readList :: ReadS [RouteSpec]
$creadList :: ReadS [RouteSpec]
readsPrec :: Int -> ReadS RouteSpec
$creadsPrec :: Int -> ReadS RouteSpec
Prelude.Read, Int -> RouteSpec -> ShowS
[RouteSpec] -> ShowS
RouteSpec -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RouteSpec] -> ShowS
$cshowList :: [RouteSpec] -> ShowS
show :: RouteSpec -> String
$cshow :: RouteSpec -> String
showsPrec :: Int -> RouteSpec -> ShowS
$cshowsPrec :: Int -> RouteSpec -> ShowS
Prelude.Show, forall x. Rep RouteSpec x -> RouteSpec
forall x. RouteSpec -> Rep RouteSpec x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RouteSpec x -> RouteSpec
$cfrom :: forall x. RouteSpec -> Rep RouteSpec x
Prelude.Generic)

-- |
-- Create a value of 'RouteSpec' 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:
--
-- 'grpcRoute', 'routeSpec_grpcRoute' - An object that represents the specification of a gRPC route.
--
-- 'http2Route', 'routeSpec_http2Route' - An object that represents the specification of an HTTP\/2 route.
--
-- 'httpRoute', 'routeSpec_httpRoute' - An object that represents the specification of an HTTP route.
--
-- 'priority', 'routeSpec_priority' - The priority for the route. Routes are matched based on the specified
-- value, where 0 is the highest priority.
--
-- 'tcpRoute', 'routeSpec_tcpRoute' - An object that represents the specification of a TCP route.
newRouteSpec ::
  RouteSpec
newRouteSpec :: RouteSpec
newRouteSpec =
  RouteSpec'
    { $sel:grpcRoute:RouteSpec' :: Maybe GrpcRoute
grpcRoute = forall a. Maybe a
Prelude.Nothing,
      $sel:http2Route:RouteSpec' :: Maybe HttpRoute
http2Route = forall a. Maybe a
Prelude.Nothing,
      $sel:httpRoute:RouteSpec' :: Maybe HttpRoute
httpRoute = forall a. Maybe a
Prelude.Nothing,
      $sel:priority:RouteSpec' :: Maybe Natural
priority = forall a. Maybe a
Prelude.Nothing,
      $sel:tcpRoute:RouteSpec' :: Maybe TcpRoute
tcpRoute = forall a. Maybe a
Prelude.Nothing
    }

-- | An object that represents the specification of a gRPC route.
routeSpec_grpcRoute :: Lens.Lens' RouteSpec (Prelude.Maybe GrpcRoute)
routeSpec_grpcRoute :: Lens' RouteSpec (Maybe GrpcRoute)
routeSpec_grpcRoute = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RouteSpec' {Maybe GrpcRoute
grpcRoute :: Maybe GrpcRoute
$sel:grpcRoute:RouteSpec' :: RouteSpec -> Maybe GrpcRoute
grpcRoute} -> Maybe GrpcRoute
grpcRoute) (\s :: RouteSpec
s@RouteSpec' {} Maybe GrpcRoute
a -> RouteSpec
s {$sel:grpcRoute:RouteSpec' :: Maybe GrpcRoute
grpcRoute = Maybe GrpcRoute
a} :: RouteSpec)

-- | An object that represents the specification of an HTTP\/2 route.
routeSpec_http2Route :: Lens.Lens' RouteSpec (Prelude.Maybe HttpRoute)
routeSpec_http2Route :: Lens' RouteSpec (Maybe HttpRoute)
routeSpec_http2Route = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RouteSpec' {Maybe HttpRoute
http2Route :: Maybe HttpRoute
$sel:http2Route:RouteSpec' :: RouteSpec -> Maybe HttpRoute
http2Route} -> Maybe HttpRoute
http2Route) (\s :: RouteSpec
s@RouteSpec' {} Maybe HttpRoute
a -> RouteSpec
s {$sel:http2Route:RouteSpec' :: Maybe HttpRoute
http2Route = Maybe HttpRoute
a} :: RouteSpec)

-- | An object that represents the specification of an HTTP route.
routeSpec_httpRoute :: Lens.Lens' RouteSpec (Prelude.Maybe HttpRoute)
routeSpec_httpRoute :: Lens' RouteSpec (Maybe HttpRoute)
routeSpec_httpRoute = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RouteSpec' {Maybe HttpRoute
httpRoute :: Maybe HttpRoute
$sel:httpRoute:RouteSpec' :: RouteSpec -> Maybe HttpRoute
httpRoute} -> Maybe HttpRoute
httpRoute) (\s :: RouteSpec
s@RouteSpec' {} Maybe HttpRoute
a -> RouteSpec
s {$sel:httpRoute:RouteSpec' :: Maybe HttpRoute
httpRoute = Maybe HttpRoute
a} :: RouteSpec)

-- | The priority for the route. Routes are matched based on the specified
-- value, where 0 is the highest priority.
routeSpec_priority :: Lens.Lens' RouteSpec (Prelude.Maybe Prelude.Natural)
routeSpec_priority :: Lens' RouteSpec (Maybe Natural)
routeSpec_priority = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RouteSpec' {Maybe Natural
priority :: Maybe Natural
$sel:priority:RouteSpec' :: RouteSpec -> Maybe Natural
priority} -> Maybe Natural
priority) (\s :: RouteSpec
s@RouteSpec' {} Maybe Natural
a -> RouteSpec
s {$sel:priority:RouteSpec' :: Maybe Natural
priority = Maybe Natural
a} :: RouteSpec)

-- | An object that represents the specification of a TCP route.
routeSpec_tcpRoute :: Lens.Lens' RouteSpec (Prelude.Maybe TcpRoute)
routeSpec_tcpRoute :: Lens' RouteSpec (Maybe TcpRoute)
routeSpec_tcpRoute = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RouteSpec' {Maybe TcpRoute
tcpRoute :: Maybe TcpRoute
$sel:tcpRoute:RouteSpec' :: RouteSpec -> Maybe TcpRoute
tcpRoute} -> Maybe TcpRoute
tcpRoute) (\s :: RouteSpec
s@RouteSpec' {} Maybe TcpRoute
a -> RouteSpec
s {$sel:tcpRoute:RouteSpec' :: Maybe TcpRoute
tcpRoute = Maybe TcpRoute
a} :: RouteSpec)

instance Data.FromJSON RouteSpec where
  parseJSON :: Value -> Parser RouteSpec
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"RouteSpec"
      ( \Object
x ->
          Maybe GrpcRoute
-> Maybe HttpRoute
-> Maybe HttpRoute
-> Maybe Natural
-> Maybe TcpRoute
-> RouteSpec
RouteSpec'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"grpcRoute")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"http2Route")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"httpRoute")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"priority")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"tcpRoute")
      )

instance Prelude.Hashable RouteSpec where
  hashWithSalt :: Int -> RouteSpec -> Int
hashWithSalt Int
_salt RouteSpec' {Maybe Natural
Maybe TcpRoute
Maybe HttpRoute
Maybe GrpcRoute
tcpRoute :: Maybe TcpRoute
priority :: Maybe Natural
httpRoute :: Maybe HttpRoute
http2Route :: Maybe HttpRoute
grpcRoute :: Maybe GrpcRoute
$sel:tcpRoute:RouteSpec' :: RouteSpec -> Maybe TcpRoute
$sel:priority:RouteSpec' :: RouteSpec -> Maybe Natural
$sel:httpRoute:RouteSpec' :: RouteSpec -> Maybe HttpRoute
$sel:http2Route:RouteSpec' :: RouteSpec -> Maybe HttpRoute
$sel:grpcRoute:RouteSpec' :: RouteSpec -> Maybe GrpcRoute
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe GrpcRoute
grpcRoute
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe HttpRoute
http2Route
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe HttpRoute
httpRoute
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
priority
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TcpRoute
tcpRoute

instance Prelude.NFData RouteSpec where
  rnf :: RouteSpec -> ()
rnf RouteSpec' {Maybe Natural
Maybe TcpRoute
Maybe HttpRoute
Maybe GrpcRoute
tcpRoute :: Maybe TcpRoute
priority :: Maybe Natural
httpRoute :: Maybe HttpRoute
http2Route :: Maybe HttpRoute
grpcRoute :: Maybe GrpcRoute
$sel:tcpRoute:RouteSpec' :: RouteSpec -> Maybe TcpRoute
$sel:priority:RouteSpec' :: RouteSpec -> Maybe Natural
$sel:httpRoute:RouteSpec' :: RouteSpec -> Maybe HttpRoute
$sel:http2Route:RouteSpec' :: RouteSpec -> Maybe HttpRoute
$sel:grpcRoute:RouteSpec' :: RouteSpec -> Maybe GrpcRoute
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe GrpcRoute
grpcRoute
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe HttpRoute
http2Route
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe HttpRoute
httpRoute
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
priority
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TcpRoute
tcpRoute

instance Data.ToJSON RouteSpec where
  toJSON :: RouteSpec -> Value
toJSON RouteSpec' {Maybe Natural
Maybe TcpRoute
Maybe HttpRoute
Maybe GrpcRoute
tcpRoute :: Maybe TcpRoute
priority :: Maybe Natural
httpRoute :: Maybe HttpRoute
http2Route :: Maybe HttpRoute
grpcRoute :: Maybe GrpcRoute
$sel:tcpRoute:RouteSpec' :: RouteSpec -> Maybe TcpRoute
$sel:priority:RouteSpec' :: RouteSpec -> Maybe Natural
$sel:httpRoute:RouteSpec' :: RouteSpec -> Maybe HttpRoute
$sel:http2Route:RouteSpec' :: RouteSpec -> Maybe HttpRoute
$sel:grpcRoute:RouteSpec' :: RouteSpec -> Maybe GrpcRoute
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"grpcRoute" 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 GrpcRoute
grpcRoute,
            (Key
"http2Route" 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 HttpRoute
http2Route,
            (Key
"httpRoute" 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 HttpRoute
httpRoute,
            (Key
"priority" 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 Natural
priority,
            (Key
"tcpRoute" 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 TcpRoute
tcpRoute
          ]
      )