{-# 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.ECS.Types.NetworkBinding
-- 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.ECS.Types.NetworkBinding where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.ECS.Types.TransportProtocol
import qualified Amazonka.Prelude as Prelude

-- | Details on the network bindings between a container and its host
-- container instance. After a task reaches the @RUNNING@ status, manual
-- and automatic host and container port assignments are visible in the
-- @networkBindings@ section of DescribeTasks API responses.
--
-- /See:/ 'newNetworkBinding' smart constructor.
data NetworkBinding = NetworkBinding'
  { -- | The IP address that the container is bound to on the container instance.
    NetworkBinding -> Maybe Text
bindIP :: Prelude.Maybe Prelude.Text,
    -- | The port number on the container that\'s used with the network binding.
    NetworkBinding -> Maybe Int
containerPort :: Prelude.Maybe Prelude.Int,
    -- | The port number range on the container that\'s bound to the dynamically
    -- mapped host port range.
    --
    -- The following rules apply when you specify a @containerPortRange@:
    --
    -- -   You must use either the @bridge@ network mode or the @awsvpc@
    --     network mode.
    --
    -- -   This parameter is available for both the EC2 and Fargate launch
    --     types.
    --
    -- -   This parameter is available for both the Linux and Windows operating
    --     systems.
    --
    -- -   The container instance must have at least version 1.67.0 of the
    --     container agent and at least version 1.67.0-1 of the @ecs-init@
    --     package
    --
    -- -   You can specify a maximum of 100 port ranges per container.
    --
    -- -   You do not specify a @hostPortRange@. The value of the
    --     @hostPortRange@ is set as follows:
    --
    --     -   For containers in a task with the @awsvpc@ network mode, the
    --         @hostPort@ is set to the same value as the @containerPort@. This
    --         is a static mapping strategy.
    --
    --     -   For containers in a task with the @bridge@ network mode, the
    --         Amazon ECS agent finds open host ports from the default
    --         ephemeral range and passes it to docker to bind them to the
    --         container ports.
    --
    -- -   The @containerPortRange@ valid values are between 1 and 65535.
    --
    -- -   A port can only be included in one port mapping per container.
    --
    -- -   You cannot specify overlapping port ranges.
    --
    -- -   The first port in the range must be less than last port in the
    --     range.
    --
    -- -   Docker recommends that you turn off the docker-proxy in the Docker
    --     daemon config file when you have a large number of ports.
    --
    --     For more information, see
    --     <https://github.com/moby/moby/issues/11185 Issue #11185> on the
    --     Github website.
    --
    --     For information about how to turn off the docker-proxy in the Docker
    --     daemon config file, see
    --     <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/bootstrap_container_instance.html#bootstrap_docker_daemon Docker daemon>
    --     in the /Amazon ECS Developer Guide/.
    --
    -- You can call
    -- <https://docs.aws.amazon.com/AmazonECS/latest/APIReference/API_DescribeTasks.html DescribeTasks>
    -- to view the @hostPortRange@ which are the host ports that are bound to
    -- the container ports.
    NetworkBinding -> Maybe Text
containerPortRange :: Prelude.Maybe Prelude.Text,
    -- | The port number on the host that\'s used with the network binding.
    NetworkBinding -> Maybe Int
hostPort :: Prelude.Maybe Prelude.Int,
    -- | The port number range on the host that\'s used with the network binding.
    -- This is assigned is assigned by Docker and delivered by the Amazon ECS
    -- agent.
    NetworkBinding -> Maybe Text
hostPortRange :: Prelude.Maybe Prelude.Text,
    -- | The protocol used for the network binding.
    NetworkBinding -> Maybe TransportProtocol
protocol :: Prelude.Maybe TransportProtocol
  }
  deriving (NetworkBinding -> NetworkBinding -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NetworkBinding -> NetworkBinding -> Bool
$c/= :: NetworkBinding -> NetworkBinding -> Bool
== :: NetworkBinding -> NetworkBinding -> Bool
$c== :: NetworkBinding -> NetworkBinding -> Bool
Prelude.Eq, ReadPrec [NetworkBinding]
ReadPrec NetworkBinding
Int -> ReadS NetworkBinding
ReadS [NetworkBinding]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [NetworkBinding]
$creadListPrec :: ReadPrec [NetworkBinding]
readPrec :: ReadPrec NetworkBinding
$creadPrec :: ReadPrec NetworkBinding
readList :: ReadS [NetworkBinding]
$creadList :: ReadS [NetworkBinding]
readsPrec :: Int -> ReadS NetworkBinding
$creadsPrec :: Int -> ReadS NetworkBinding
Prelude.Read, Int -> NetworkBinding -> ShowS
[NetworkBinding] -> ShowS
NetworkBinding -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NetworkBinding] -> ShowS
$cshowList :: [NetworkBinding] -> ShowS
show :: NetworkBinding -> String
$cshow :: NetworkBinding -> String
showsPrec :: Int -> NetworkBinding -> ShowS
$cshowsPrec :: Int -> NetworkBinding -> ShowS
Prelude.Show, forall x. Rep NetworkBinding x -> NetworkBinding
forall x. NetworkBinding -> Rep NetworkBinding x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NetworkBinding x -> NetworkBinding
$cfrom :: forall x. NetworkBinding -> Rep NetworkBinding x
Prelude.Generic)

-- |
-- Create a value of 'NetworkBinding' 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:
--
-- 'bindIP', 'networkBinding_bindIP' - The IP address that the container is bound to on the container instance.
--
-- 'containerPort', 'networkBinding_containerPort' - The port number on the container that\'s used with the network binding.
--
-- 'containerPortRange', 'networkBinding_containerPortRange' - The port number range on the container that\'s bound to the dynamically
-- mapped host port range.
--
-- The following rules apply when you specify a @containerPortRange@:
--
-- -   You must use either the @bridge@ network mode or the @awsvpc@
--     network mode.
--
-- -   This parameter is available for both the EC2 and Fargate launch
--     types.
--
-- -   This parameter is available for both the Linux and Windows operating
--     systems.
--
-- -   The container instance must have at least version 1.67.0 of the
--     container agent and at least version 1.67.0-1 of the @ecs-init@
--     package
--
-- -   You can specify a maximum of 100 port ranges per container.
--
-- -   You do not specify a @hostPortRange@. The value of the
--     @hostPortRange@ is set as follows:
--
--     -   For containers in a task with the @awsvpc@ network mode, the
--         @hostPort@ is set to the same value as the @containerPort@. This
--         is a static mapping strategy.
--
--     -   For containers in a task with the @bridge@ network mode, the
--         Amazon ECS agent finds open host ports from the default
--         ephemeral range and passes it to docker to bind them to the
--         container ports.
--
-- -   The @containerPortRange@ valid values are between 1 and 65535.
--
-- -   A port can only be included in one port mapping per container.
--
-- -   You cannot specify overlapping port ranges.
--
-- -   The first port in the range must be less than last port in the
--     range.
--
-- -   Docker recommends that you turn off the docker-proxy in the Docker
--     daemon config file when you have a large number of ports.
--
--     For more information, see
--     <https://github.com/moby/moby/issues/11185 Issue #11185> on the
--     Github website.
--
--     For information about how to turn off the docker-proxy in the Docker
--     daemon config file, see
--     <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/bootstrap_container_instance.html#bootstrap_docker_daemon Docker daemon>
--     in the /Amazon ECS Developer Guide/.
--
-- You can call
-- <https://docs.aws.amazon.com/AmazonECS/latest/APIReference/API_DescribeTasks.html DescribeTasks>
-- to view the @hostPortRange@ which are the host ports that are bound to
-- the container ports.
--
-- 'hostPort', 'networkBinding_hostPort' - The port number on the host that\'s used with the network binding.
--
-- 'hostPortRange', 'networkBinding_hostPortRange' - The port number range on the host that\'s used with the network binding.
-- This is assigned is assigned by Docker and delivered by the Amazon ECS
-- agent.
--
-- 'protocol', 'networkBinding_protocol' - The protocol used for the network binding.
newNetworkBinding ::
  NetworkBinding
newNetworkBinding :: NetworkBinding
newNetworkBinding =
  NetworkBinding'
    { $sel:bindIP:NetworkBinding' :: Maybe Text
bindIP = forall a. Maybe a
Prelude.Nothing,
      $sel:containerPort:NetworkBinding' :: Maybe Int
containerPort = forall a. Maybe a
Prelude.Nothing,
      $sel:containerPortRange:NetworkBinding' :: Maybe Text
containerPortRange = forall a. Maybe a
Prelude.Nothing,
      $sel:hostPort:NetworkBinding' :: Maybe Int
hostPort = forall a. Maybe a
Prelude.Nothing,
      $sel:hostPortRange:NetworkBinding' :: Maybe Text
hostPortRange = forall a. Maybe a
Prelude.Nothing,
      $sel:protocol:NetworkBinding' :: Maybe TransportProtocol
protocol = forall a. Maybe a
Prelude.Nothing
    }

-- | The IP address that the container is bound to on the container instance.
networkBinding_bindIP :: Lens.Lens' NetworkBinding (Prelude.Maybe Prelude.Text)
networkBinding_bindIP :: Lens' NetworkBinding (Maybe Text)
networkBinding_bindIP = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\NetworkBinding' {Maybe Text
bindIP :: Maybe Text
$sel:bindIP:NetworkBinding' :: NetworkBinding -> Maybe Text
bindIP} -> Maybe Text
bindIP) (\s :: NetworkBinding
s@NetworkBinding' {} Maybe Text
a -> NetworkBinding
s {$sel:bindIP:NetworkBinding' :: Maybe Text
bindIP = Maybe Text
a} :: NetworkBinding)

-- | The port number on the container that\'s used with the network binding.
networkBinding_containerPort :: Lens.Lens' NetworkBinding (Prelude.Maybe Prelude.Int)
networkBinding_containerPort :: Lens' NetworkBinding (Maybe Int)
networkBinding_containerPort = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\NetworkBinding' {Maybe Int
containerPort :: Maybe Int
$sel:containerPort:NetworkBinding' :: NetworkBinding -> Maybe Int
containerPort} -> Maybe Int
containerPort) (\s :: NetworkBinding
s@NetworkBinding' {} Maybe Int
a -> NetworkBinding
s {$sel:containerPort:NetworkBinding' :: Maybe Int
containerPort = Maybe Int
a} :: NetworkBinding)

-- | The port number range on the container that\'s bound to the dynamically
-- mapped host port range.
--
-- The following rules apply when you specify a @containerPortRange@:
--
-- -   You must use either the @bridge@ network mode or the @awsvpc@
--     network mode.
--
-- -   This parameter is available for both the EC2 and Fargate launch
--     types.
--
-- -   This parameter is available for both the Linux and Windows operating
--     systems.
--
-- -   The container instance must have at least version 1.67.0 of the
--     container agent and at least version 1.67.0-1 of the @ecs-init@
--     package
--
-- -   You can specify a maximum of 100 port ranges per container.
--
-- -   You do not specify a @hostPortRange@. The value of the
--     @hostPortRange@ is set as follows:
--
--     -   For containers in a task with the @awsvpc@ network mode, the
--         @hostPort@ is set to the same value as the @containerPort@. This
--         is a static mapping strategy.
--
--     -   For containers in a task with the @bridge@ network mode, the
--         Amazon ECS agent finds open host ports from the default
--         ephemeral range and passes it to docker to bind them to the
--         container ports.
--
-- -   The @containerPortRange@ valid values are between 1 and 65535.
--
-- -   A port can only be included in one port mapping per container.
--
-- -   You cannot specify overlapping port ranges.
--
-- -   The first port in the range must be less than last port in the
--     range.
--
-- -   Docker recommends that you turn off the docker-proxy in the Docker
--     daemon config file when you have a large number of ports.
--
--     For more information, see
--     <https://github.com/moby/moby/issues/11185 Issue #11185> on the
--     Github website.
--
--     For information about how to turn off the docker-proxy in the Docker
--     daemon config file, see
--     <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/bootstrap_container_instance.html#bootstrap_docker_daemon Docker daemon>
--     in the /Amazon ECS Developer Guide/.
--
-- You can call
-- <https://docs.aws.amazon.com/AmazonECS/latest/APIReference/API_DescribeTasks.html DescribeTasks>
-- to view the @hostPortRange@ which are the host ports that are bound to
-- the container ports.
networkBinding_containerPortRange :: Lens.Lens' NetworkBinding (Prelude.Maybe Prelude.Text)
networkBinding_containerPortRange :: Lens' NetworkBinding (Maybe Text)
networkBinding_containerPortRange = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\NetworkBinding' {Maybe Text
containerPortRange :: Maybe Text
$sel:containerPortRange:NetworkBinding' :: NetworkBinding -> Maybe Text
containerPortRange} -> Maybe Text
containerPortRange) (\s :: NetworkBinding
s@NetworkBinding' {} Maybe Text
a -> NetworkBinding
s {$sel:containerPortRange:NetworkBinding' :: Maybe Text
containerPortRange = Maybe Text
a} :: NetworkBinding)

-- | The port number on the host that\'s used with the network binding.
networkBinding_hostPort :: Lens.Lens' NetworkBinding (Prelude.Maybe Prelude.Int)
networkBinding_hostPort :: Lens' NetworkBinding (Maybe Int)
networkBinding_hostPort = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\NetworkBinding' {Maybe Int
hostPort :: Maybe Int
$sel:hostPort:NetworkBinding' :: NetworkBinding -> Maybe Int
hostPort} -> Maybe Int
hostPort) (\s :: NetworkBinding
s@NetworkBinding' {} Maybe Int
a -> NetworkBinding
s {$sel:hostPort:NetworkBinding' :: Maybe Int
hostPort = Maybe Int
a} :: NetworkBinding)

-- | The port number range on the host that\'s used with the network binding.
-- This is assigned is assigned by Docker and delivered by the Amazon ECS
-- agent.
networkBinding_hostPortRange :: Lens.Lens' NetworkBinding (Prelude.Maybe Prelude.Text)
networkBinding_hostPortRange :: Lens' NetworkBinding (Maybe Text)
networkBinding_hostPortRange = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\NetworkBinding' {Maybe Text
hostPortRange :: Maybe Text
$sel:hostPortRange:NetworkBinding' :: NetworkBinding -> Maybe Text
hostPortRange} -> Maybe Text
hostPortRange) (\s :: NetworkBinding
s@NetworkBinding' {} Maybe Text
a -> NetworkBinding
s {$sel:hostPortRange:NetworkBinding' :: Maybe Text
hostPortRange = Maybe Text
a} :: NetworkBinding)

-- | The protocol used for the network binding.
networkBinding_protocol :: Lens.Lens' NetworkBinding (Prelude.Maybe TransportProtocol)
networkBinding_protocol :: Lens' NetworkBinding (Maybe TransportProtocol)
networkBinding_protocol = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\NetworkBinding' {Maybe TransportProtocol
protocol :: Maybe TransportProtocol
$sel:protocol:NetworkBinding' :: NetworkBinding -> Maybe TransportProtocol
protocol} -> Maybe TransportProtocol
protocol) (\s :: NetworkBinding
s@NetworkBinding' {} Maybe TransportProtocol
a -> NetworkBinding
s {$sel:protocol:NetworkBinding' :: Maybe TransportProtocol
protocol = Maybe TransportProtocol
a} :: NetworkBinding)

instance Data.FromJSON NetworkBinding where
  parseJSON :: Value -> Parser NetworkBinding
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"NetworkBinding"
      ( \Object
x ->
          Maybe Text
-> Maybe Int
-> Maybe Text
-> Maybe Int
-> Maybe Text
-> Maybe TransportProtocol
-> NetworkBinding
NetworkBinding'
            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
"bindIP")
            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
"containerPort")
            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
"containerPortRange")
            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
"hostPort")
            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
"hostPortRange")
            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
"protocol")
      )

instance Prelude.Hashable NetworkBinding where
  hashWithSalt :: Int -> NetworkBinding -> Int
hashWithSalt Int
_salt NetworkBinding' {Maybe Int
Maybe Text
Maybe TransportProtocol
protocol :: Maybe TransportProtocol
hostPortRange :: Maybe Text
hostPort :: Maybe Int
containerPortRange :: Maybe Text
containerPort :: Maybe Int
bindIP :: Maybe Text
$sel:protocol:NetworkBinding' :: NetworkBinding -> Maybe TransportProtocol
$sel:hostPortRange:NetworkBinding' :: NetworkBinding -> Maybe Text
$sel:hostPort:NetworkBinding' :: NetworkBinding -> Maybe Int
$sel:containerPortRange:NetworkBinding' :: NetworkBinding -> Maybe Text
$sel:containerPort:NetworkBinding' :: NetworkBinding -> Maybe Int
$sel:bindIP:NetworkBinding' :: NetworkBinding -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
bindIP
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
containerPort
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
containerPortRange
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
hostPort
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
hostPortRange
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TransportProtocol
protocol

instance Prelude.NFData NetworkBinding where
  rnf :: NetworkBinding -> ()
rnf NetworkBinding' {Maybe Int
Maybe Text
Maybe TransportProtocol
protocol :: Maybe TransportProtocol
hostPortRange :: Maybe Text
hostPort :: Maybe Int
containerPortRange :: Maybe Text
containerPort :: Maybe Int
bindIP :: Maybe Text
$sel:protocol:NetworkBinding' :: NetworkBinding -> Maybe TransportProtocol
$sel:hostPortRange:NetworkBinding' :: NetworkBinding -> Maybe Text
$sel:hostPort:NetworkBinding' :: NetworkBinding -> Maybe Int
$sel:containerPortRange:NetworkBinding' :: NetworkBinding -> Maybe Text
$sel:containerPort:NetworkBinding' :: NetworkBinding -> Maybe Int
$sel:bindIP:NetworkBinding' :: NetworkBinding -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
bindIP
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
containerPort
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
containerPortRange
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
hostPort
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
hostPortRange
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TransportProtocol
protocol

instance Data.ToJSON NetworkBinding where
  toJSON :: NetworkBinding -> Value
toJSON NetworkBinding' {Maybe Int
Maybe Text
Maybe TransportProtocol
protocol :: Maybe TransportProtocol
hostPortRange :: Maybe Text
hostPort :: Maybe Int
containerPortRange :: Maybe Text
containerPort :: Maybe Int
bindIP :: Maybe Text
$sel:protocol:NetworkBinding' :: NetworkBinding -> Maybe TransportProtocol
$sel:hostPortRange:NetworkBinding' :: NetworkBinding -> Maybe Text
$sel:hostPort:NetworkBinding' :: NetworkBinding -> Maybe Int
$sel:containerPortRange:NetworkBinding' :: NetworkBinding -> Maybe Text
$sel:containerPort:NetworkBinding' :: NetworkBinding -> Maybe Int
$sel:bindIP:NetworkBinding' :: NetworkBinding -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"bindIP" 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
bindIP,
            (Key
"containerPort" 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 Int
containerPort,
            (Key
"containerPortRange" 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
containerPortRange,
            (Key
"hostPort" 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 Int
hostPort,
            (Key
"hostPortRange" 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
hostPortRange,
            (Key
"protocol" 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 TransportProtocol
protocol
          ]
      )