{-# 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.GroundStation.CreateMissionProfile
-- 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 mission profile.
--
-- @dataflowEdges@ is a list of lists of strings. Each lower level list of
-- strings has two elements: a /from/ ARN and a /to/ ARN.
module Amazonka.GroundStation.CreateMissionProfile
  ( -- * Creating a Request
    CreateMissionProfile (..),
    newCreateMissionProfile,

    -- * Request Lenses
    createMissionProfile_contactPostPassDurationSeconds,
    createMissionProfile_contactPrePassDurationSeconds,
    createMissionProfile_tags,
    createMissionProfile_dataflowEdges,
    createMissionProfile_minimumViableContactDurationSeconds,
    createMissionProfile_name,
    createMissionProfile_trackingConfigArn,

    -- * Destructuring the Response
    MissionProfileIdResponse (..),
    newMissionProfileIdResponse,

    -- * Response Lenses
    missionProfileIdResponse_missionProfileId,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.GroundStation.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- |
--
-- /See:/ 'newCreateMissionProfile' smart constructor.
data CreateMissionProfile = CreateMissionProfile'
  { -- | Amount of time after a contact ends that you’d like to receive a
    -- CloudWatch event indicating the pass has finished.
    CreateMissionProfile -> Maybe Natural
contactPostPassDurationSeconds :: Prelude.Maybe Prelude.Natural,
    -- | Amount of time prior to contact start you’d like to receive a CloudWatch
    -- event indicating an upcoming pass.
    CreateMissionProfile -> Maybe Natural
contactPrePassDurationSeconds :: Prelude.Maybe Prelude.Natural,
    -- | Tags assigned to a mission profile.
    CreateMissionProfile -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | A list of lists of ARNs. Each list of ARNs is an edge, with a /from/
    -- @Config@ and a /to/ @Config@.
    CreateMissionProfile -> [NonEmpty Text]
dataflowEdges :: [Prelude.NonEmpty Prelude.Text],
    -- | Smallest amount of time in seconds that you’d like to see for an
    -- available contact. AWS Ground Station will not present you with contacts
    -- shorter than this duration.
    CreateMissionProfile -> Natural
minimumViableContactDurationSeconds :: Prelude.Natural,
    -- | Name of a mission profile.
    CreateMissionProfile -> Text
name :: Prelude.Text,
    -- | ARN of a tracking @Config@.
    CreateMissionProfile -> Text
trackingConfigArn :: Prelude.Text
  }
  deriving (CreateMissionProfile -> CreateMissionProfile -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateMissionProfile -> CreateMissionProfile -> Bool
$c/= :: CreateMissionProfile -> CreateMissionProfile -> Bool
== :: CreateMissionProfile -> CreateMissionProfile -> Bool
$c== :: CreateMissionProfile -> CreateMissionProfile -> Bool
Prelude.Eq, ReadPrec [CreateMissionProfile]
ReadPrec CreateMissionProfile
Int -> ReadS CreateMissionProfile
ReadS [CreateMissionProfile]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateMissionProfile]
$creadListPrec :: ReadPrec [CreateMissionProfile]
readPrec :: ReadPrec CreateMissionProfile
$creadPrec :: ReadPrec CreateMissionProfile
readList :: ReadS [CreateMissionProfile]
$creadList :: ReadS [CreateMissionProfile]
readsPrec :: Int -> ReadS CreateMissionProfile
$creadsPrec :: Int -> ReadS CreateMissionProfile
Prelude.Read, Int -> CreateMissionProfile -> ShowS
[CreateMissionProfile] -> ShowS
CreateMissionProfile -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateMissionProfile] -> ShowS
$cshowList :: [CreateMissionProfile] -> ShowS
show :: CreateMissionProfile -> String
$cshow :: CreateMissionProfile -> String
showsPrec :: Int -> CreateMissionProfile -> ShowS
$cshowsPrec :: Int -> CreateMissionProfile -> ShowS
Prelude.Show, forall x. Rep CreateMissionProfile x -> CreateMissionProfile
forall x. CreateMissionProfile -> Rep CreateMissionProfile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateMissionProfile x -> CreateMissionProfile
$cfrom :: forall x. CreateMissionProfile -> Rep CreateMissionProfile x
Prelude.Generic)

-- |
-- Create a value of 'CreateMissionProfile' 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:
--
-- 'contactPostPassDurationSeconds', 'createMissionProfile_contactPostPassDurationSeconds' - Amount of time after a contact ends that you’d like to receive a
-- CloudWatch event indicating the pass has finished.
--
-- 'contactPrePassDurationSeconds', 'createMissionProfile_contactPrePassDurationSeconds' - Amount of time prior to contact start you’d like to receive a CloudWatch
-- event indicating an upcoming pass.
--
-- 'tags', 'createMissionProfile_tags' - Tags assigned to a mission profile.
--
-- 'dataflowEdges', 'createMissionProfile_dataflowEdges' - A list of lists of ARNs. Each list of ARNs is an edge, with a /from/
-- @Config@ and a /to/ @Config@.
--
-- 'minimumViableContactDurationSeconds', 'createMissionProfile_minimumViableContactDurationSeconds' - Smallest amount of time in seconds that you’d like to see for an
-- available contact. AWS Ground Station will not present you with contacts
-- shorter than this duration.
--
-- 'name', 'createMissionProfile_name' - Name of a mission profile.
--
-- 'trackingConfigArn', 'createMissionProfile_trackingConfigArn' - ARN of a tracking @Config@.
newCreateMissionProfile ::
  -- | 'minimumViableContactDurationSeconds'
  Prelude.Natural ->
  -- | 'name'
  Prelude.Text ->
  -- | 'trackingConfigArn'
  Prelude.Text ->
  CreateMissionProfile
newCreateMissionProfile :: Natural -> Text -> Text -> CreateMissionProfile
newCreateMissionProfile
  Natural
pMinimumViableContactDurationSeconds_
  Text
pName_
  Text
pTrackingConfigArn_ =
    CreateMissionProfile'
      { $sel:contactPostPassDurationSeconds:CreateMissionProfile' :: Maybe Natural
contactPostPassDurationSeconds =
          forall a. Maybe a
Prelude.Nothing,
        $sel:contactPrePassDurationSeconds:CreateMissionProfile' :: Maybe Natural
contactPrePassDurationSeconds = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateMissionProfile' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:dataflowEdges:CreateMissionProfile' :: [NonEmpty Text]
dataflowEdges = forall a. Monoid a => a
Prelude.mempty,
        $sel:minimumViableContactDurationSeconds:CreateMissionProfile' :: Natural
minimumViableContactDurationSeconds =
          Natural
pMinimumViableContactDurationSeconds_,
        $sel:name:CreateMissionProfile' :: Text
name = Text
pName_,
        $sel:trackingConfigArn:CreateMissionProfile' :: Text
trackingConfigArn = Text
pTrackingConfigArn_
      }

-- | Amount of time after a contact ends that you’d like to receive a
-- CloudWatch event indicating the pass has finished.
createMissionProfile_contactPostPassDurationSeconds :: Lens.Lens' CreateMissionProfile (Prelude.Maybe Prelude.Natural)
createMissionProfile_contactPostPassDurationSeconds :: Lens' CreateMissionProfile (Maybe Natural)
createMissionProfile_contactPostPassDurationSeconds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMissionProfile' {Maybe Natural
contactPostPassDurationSeconds :: Maybe Natural
$sel:contactPostPassDurationSeconds:CreateMissionProfile' :: CreateMissionProfile -> Maybe Natural
contactPostPassDurationSeconds} -> Maybe Natural
contactPostPassDurationSeconds) (\s :: CreateMissionProfile
s@CreateMissionProfile' {} Maybe Natural
a -> CreateMissionProfile
s {$sel:contactPostPassDurationSeconds:CreateMissionProfile' :: Maybe Natural
contactPostPassDurationSeconds = Maybe Natural
a} :: CreateMissionProfile)

-- | Amount of time prior to contact start you’d like to receive a CloudWatch
-- event indicating an upcoming pass.
createMissionProfile_contactPrePassDurationSeconds :: Lens.Lens' CreateMissionProfile (Prelude.Maybe Prelude.Natural)
createMissionProfile_contactPrePassDurationSeconds :: Lens' CreateMissionProfile (Maybe Natural)
createMissionProfile_contactPrePassDurationSeconds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMissionProfile' {Maybe Natural
contactPrePassDurationSeconds :: Maybe Natural
$sel:contactPrePassDurationSeconds:CreateMissionProfile' :: CreateMissionProfile -> Maybe Natural
contactPrePassDurationSeconds} -> Maybe Natural
contactPrePassDurationSeconds) (\s :: CreateMissionProfile
s@CreateMissionProfile' {} Maybe Natural
a -> CreateMissionProfile
s {$sel:contactPrePassDurationSeconds:CreateMissionProfile' :: Maybe Natural
contactPrePassDurationSeconds = Maybe Natural
a} :: CreateMissionProfile)

-- | Tags assigned to a mission profile.
createMissionProfile_tags :: Lens.Lens' CreateMissionProfile (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createMissionProfile_tags :: Lens' CreateMissionProfile (Maybe (HashMap Text Text))
createMissionProfile_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMissionProfile' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateMissionProfile' :: CreateMissionProfile -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateMissionProfile
s@CreateMissionProfile' {} Maybe (HashMap Text Text)
a -> CreateMissionProfile
s {$sel:tags:CreateMissionProfile' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateMissionProfile) 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

-- | A list of lists of ARNs. Each list of ARNs is an edge, with a /from/
-- @Config@ and a /to/ @Config@.
createMissionProfile_dataflowEdges :: Lens.Lens' CreateMissionProfile [Prelude.NonEmpty Prelude.Text]
createMissionProfile_dataflowEdges :: Lens' CreateMissionProfile [NonEmpty Text]
createMissionProfile_dataflowEdges = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMissionProfile' {[NonEmpty Text]
dataflowEdges :: [NonEmpty Text]
$sel:dataflowEdges:CreateMissionProfile' :: CreateMissionProfile -> [NonEmpty Text]
dataflowEdges} -> [NonEmpty Text]
dataflowEdges) (\s :: CreateMissionProfile
s@CreateMissionProfile' {} [NonEmpty Text]
a -> CreateMissionProfile
s {$sel:dataflowEdges:CreateMissionProfile' :: [NonEmpty Text]
dataflowEdges = [NonEmpty Text]
a} :: CreateMissionProfile) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | Smallest amount of time in seconds that you’d like to see for an
-- available contact. AWS Ground Station will not present you with contacts
-- shorter than this duration.
createMissionProfile_minimumViableContactDurationSeconds :: Lens.Lens' CreateMissionProfile Prelude.Natural
createMissionProfile_minimumViableContactDurationSeconds :: Lens' CreateMissionProfile Natural
createMissionProfile_minimumViableContactDurationSeconds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMissionProfile' {Natural
minimumViableContactDurationSeconds :: Natural
$sel:minimumViableContactDurationSeconds:CreateMissionProfile' :: CreateMissionProfile -> Natural
minimumViableContactDurationSeconds} -> Natural
minimumViableContactDurationSeconds) (\s :: CreateMissionProfile
s@CreateMissionProfile' {} Natural
a -> CreateMissionProfile
s {$sel:minimumViableContactDurationSeconds:CreateMissionProfile' :: Natural
minimumViableContactDurationSeconds = Natural
a} :: CreateMissionProfile)

-- | Name of a mission profile.
createMissionProfile_name :: Lens.Lens' CreateMissionProfile Prelude.Text
createMissionProfile_name :: Lens' CreateMissionProfile Text
createMissionProfile_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMissionProfile' {Text
name :: Text
$sel:name:CreateMissionProfile' :: CreateMissionProfile -> Text
name} -> Text
name) (\s :: CreateMissionProfile
s@CreateMissionProfile' {} Text
a -> CreateMissionProfile
s {$sel:name:CreateMissionProfile' :: Text
name = Text
a} :: CreateMissionProfile)

-- | ARN of a tracking @Config@.
createMissionProfile_trackingConfigArn :: Lens.Lens' CreateMissionProfile Prelude.Text
createMissionProfile_trackingConfigArn :: Lens' CreateMissionProfile Text
createMissionProfile_trackingConfigArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMissionProfile' {Text
trackingConfigArn :: Text
$sel:trackingConfigArn:CreateMissionProfile' :: CreateMissionProfile -> Text
trackingConfigArn} -> Text
trackingConfigArn) (\s :: CreateMissionProfile
s@CreateMissionProfile' {} Text
a -> CreateMissionProfile
s {$sel:trackingConfigArn:CreateMissionProfile' :: Text
trackingConfigArn = Text
a} :: CreateMissionProfile)

instance Core.AWSRequest CreateMissionProfile where
  type
    AWSResponse CreateMissionProfile =
      MissionProfileIdResponse
  request :: (Service -> Service)
-> CreateMissionProfile -> Request CreateMissionProfile
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 CreateMissionProfile
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateMissionProfile)))
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 CreateMissionProfile where
  hashWithSalt :: Int -> CreateMissionProfile -> Int
hashWithSalt Int
_salt CreateMissionProfile' {Natural
[NonEmpty Text]
Maybe Natural
Maybe (HashMap Text Text)
Text
trackingConfigArn :: Text
name :: Text
minimumViableContactDurationSeconds :: Natural
dataflowEdges :: [NonEmpty Text]
tags :: Maybe (HashMap Text Text)
contactPrePassDurationSeconds :: Maybe Natural
contactPostPassDurationSeconds :: Maybe Natural
$sel:trackingConfigArn:CreateMissionProfile' :: CreateMissionProfile -> Text
$sel:name:CreateMissionProfile' :: CreateMissionProfile -> Text
$sel:minimumViableContactDurationSeconds:CreateMissionProfile' :: CreateMissionProfile -> Natural
$sel:dataflowEdges:CreateMissionProfile' :: CreateMissionProfile -> [NonEmpty Text]
$sel:tags:CreateMissionProfile' :: CreateMissionProfile -> Maybe (HashMap Text Text)
$sel:contactPrePassDurationSeconds:CreateMissionProfile' :: CreateMissionProfile -> Maybe Natural
$sel:contactPostPassDurationSeconds:CreateMissionProfile' :: CreateMissionProfile -> Maybe Natural
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
contactPostPassDurationSeconds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
contactPrePassDurationSeconds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [NonEmpty Text]
dataflowEdges
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Natural
minimumViableContactDurationSeconds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
trackingConfigArn

instance Prelude.NFData CreateMissionProfile where
  rnf :: CreateMissionProfile -> ()
rnf CreateMissionProfile' {Natural
[NonEmpty Text]
Maybe Natural
Maybe (HashMap Text Text)
Text
trackingConfigArn :: Text
name :: Text
minimumViableContactDurationSeconds :: Natural
dataflowEdges :: [NonEmpty Text]
tags :: Maybe (HashMap Text Text)
contactPrePassDurationSeconds :: Maybe Natural
contactPostPassDurationSeconds :: Maybe Natural
$sel:trackingConfigArn:CreateMissionProfile' :: CreateMissionProfile -> Text
$sel:name:CreateMissionProfile' :: CreateMissionProfile -> Text
$sel:minimumViableContactDurationSeconds:CreateMissionProfile' :: CreateMissionProfile -> Natural
$sel:dataflowEdges:CreateMissionProfile' :: CreateMissionProfile -> [NonEmpty Text]
$sel:tags:CreateMissionProfile' :: CreateMissionProfile -> Maybe (HashMap Text Text)
$sel:contactPrePassDurationSeconds:CreateMissionProfile' :: CreateMissionProfile -> Maybe Natural
$sel:contactPostPassDurationSeconds:CreateMissionProfile' :: CreateMissionProfile -> Maybe Natural
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
contactPostPassDurationSeconds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
contactPrePassDurationSeconds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [NonEmpty Text]
dataflowEdges
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Natural
minimumViableContactDurationSeconds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
trackingConfigArn

instance Data.ToHeaders CreateMissionProfile where
  toHeaders :: CreateMissionProfile -> 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 CreateMissionProfile where
  toJSON :: CreateMissionProfile -> Value
toJSON CreateMissionProfile' {Natural
[NonEmpty Text]
Maybe Natural
Maybe (HashMap Text Text)
Text
trackingConfigArn :: Text
name :: Text
minimumViableContactDurationSeconds :: Natural
dataflowEdges :: [NonEmpty Text]
tags :: Maybe (HashMap Text Text)
contactPrePassDurationSeconds :: Maybe Natural
contactPostPassDurationSeconds :: Maybe Natural
$sel:trackingConfigArn:CreateMissionProfile' :: CreateMissionProfile -> Text
$sel:name:CreateMissionProfile' :: CreateMissionProfile -> Text
$sel:minimumViableContactDurationSeconds:CreateMissionProfile' :: CreateMissionProfile -> Natural
$sel:dataflowEdges:CreateMissionProfile' :: CreateMissionProfile -> [NonEmpty Text]
$sel:tags:CreateMissionProfile' :: CreateMissionProfile -> Maybe (HashMap Text Text)
$sel:contactPrePassDurationSeconds:CreateMissionProfile' :: CreateMissionProfile -> Maybe Natural
$sel:contactPostPassDurationSeconds:CreateMissionProfile' :: CreateMissionProfile -> Maybe Natural
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"contactPostPassDurationSeconds" 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
contactPostPassDurationSeconds,
            (Key
"contactPrePassDurationSeconds" 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
contactPrePassDurationSeconds,
            (Key
"tags" 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)
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"dataflowEdges" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [NonEmpty Text]
dataflowEdges),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"minimumViableContactDurationSeconds"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Natural
minimumViableContactDurationSeconds
              ),
            forall a. a -> Maybe a
Prelude.Just (Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"trackingConfigArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
trackingConfigArn)
          ]
      )

instance Data.ToPath CreateMissionProfile where
  toPath :: CreateMissionProfile -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/missionprofile"

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