{-# 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.UpdateMissionProfile
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates a mission profile.
--
-- Updating a mission profile will not update the execution parameters for
-- existing future contacts.
module Amazonka.GroundStation.UpdateMissionProfile
  ( -- * Creating a Request
    UpdateMissionProfile (..),
    newUpdateMissionProfile,

    -- * Request Lenses
    updateMissionProfile_contactPostPassDurationSeconds,
    updateMissionProfile_contactPrePassDurationSeconds,
    updateMissionProfile_dataflowEdges,
    updateMissionProfile_minimumViableContactDurationSeconds,
    updateMissionProfile_name,
    updateMissionProfile_trackingConfigArn,
    updateMissionProfile_missionProfileId,

    -- * 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:/ 'newUpdateMissionProfile' smart constructor.
data UpdateMissionProfile = UpdateMissionProfile'
  { -- | Amount of time after a contact ends that you’d like to receive a
    -- CloudWatch event indicating the pass has finished.
    UpdateMissionProfile -> Maybe Natural
contactPostPassDurationSeconds :: Prelude.Maybe Prelude.Natural,
    -- | Amount of time after a contact ends that you’d like to receive a
    -- CloudWatch event indicating the pass has finished.
    UpdateMissionProfile -> Maybe Natural
contactPrePassDurationSeconds :: Prelude.Maybe Prelude.Natural,
    -- | A list of lists of ARNs. Each list of ARNs is an edge, with a /from/
    -- @Config@ and a /to/ @Config@.
    UpdateMissionProfile -> Maybe [NonEmpty Text]
dataflowEdges :: Prelude.Maybe [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.
    UpdateMissionProfile -> Maybe Natural
minimumViableContactDurationSeconds :: Prelude.Maybe Prelude.Natural,
    -- | Name of a mission profile.
    UpdateMissionProfile -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | ARN of a tracking @Config@.
    UpdateMissionProfile -> Maybe Text
trackingConfigArn :: Prelude.Maybe Prelude.Text,
    -- | UUID of a mission profile.
    UpdateMissionProfile -> Text
missionProfileId :: Prelude.Text
  }
  deriving (UpdateMissionProfile -> UpdateMissionProfile -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateMissionProfile -> UpdateMissionProfile -> Bool
$c/= :: UpdateMissionProfile -> UpdateMissionProfile -> Bool
== :: UpdateMissionProfile -> UpdateMissionProfile -> Bool
$c== :: UpdateMissionProfile -> UpdateMissionProfile -> Bool
Prelude.Eq, ReadPrec [UpdateMissionProfile]
ReadPrec UpdateMissionProfile
Int -> ReadS UpdateMissionProfile
ReadS [UpdateMissionProfile]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateMissionProfile]
$creadListPrec :: ReadPrec [UpdateMissionProfile]
readPrec :: ReadPrec UpdateMissionProfile
$creadPrec :: ReadPrec UpdateMissionProfile
readList :: ReadS [UpdateMissionProfile]
$creadList :: ReadS [UpdateMissionProfile]
readsPrec :: Int -> ReadS UpdateMissionProfile
$creadsPrec :: Int -> ReadS UpdateMissionProfile
Prelude.Read, Int -> UpdateMissionProfile -> ShowS
[UpdateMissionProfile] -> ShowS
UpdateMissionProfile -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateMissionProfile] -> ShowS
$cshowList :: [UpdateMissionProfile] -> ShowS
show :: UpdateMissionProfile -> String
$cshow :: UpdateMissionProfile -> String
showsPrec :: Int -> UpdateMissionProfile -> ShowS
$cshowsPrec :: Int -> UpdateMissionProfile -> ShowS
Prelude.Show, forall x. Rep UpdateMissionProfile x -> UpdateMissionProfile
forall x. UpdateMissionProfile -> Rep UpdateMissionProfile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateMissionProfile x -> UpdateMissionProfile
$cfrom :: forall x. UpdateMissionProfile -> Rep UpdateMissionProfile x
Prelude.Generic)

-- |
-- Create a value of 'UpdateMissionProfile' 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', 'updateMissionProfile_contactPostPassDurationSeconds' - Amount of time after a contact ends that you’d like to receive a
-- CloudWatch event indicating the pass has finished.
--
-- 'contactPrePassDurationSeconds', 'updateMissionProfile_contactPrePassDurationSeconds' - Amount of time after a contact ends that you’d like to receive a
-- CloudWatch event indicating the pass has finished.
--
-- 'dataflowEdges', 'updateMissionProfile_dataflowEdges' - A list of lists of ARNs. Each list of ARNs is an edge, with a /from/
-- @Config@ and a /to/ @Config@.
--
-- 'minimumViableContactDurationSeconds', 'updateMissionProfile_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', 'updateMissionProfile_name' - Name of a mission profile.
--
-- 'trackingConfigArn', 'updateMissionProfile_trackingConfigArn' - ARN of a tracking @Config@.
--
-- 'missionProfileId', 'updateMissionProfile_missionProfileId' - UUID of a mission profile.
newUpdateMissionProfile ::
  -- | 'missionProfileId'
  Prelude.Text ->
  UpdateMissionProfile
newUpdateMissionProfile :: Text -> UpdateMissionProfile
newUpdateMissionProfile Text
pMissionProfileId_ =
  UpdateMissionProfile'
    { $sel:contactPostPassDurationSeconds:UpdateMissionProfile' :: Maybe Natural
contactPostPassDurationSeconds =
        forall a. Maybe a
Prelude.Nothing,
      $sel:contactPrePassDurationSeconds:UpdateMissionProfile' :: Maybe Natural
contactPrePassDurationSeconds = forall a. Maybe a
Prelude.Nothing,
      $sel:dataflowEdges:UpdateMissionProfile' :: Maybe [NonEmpty Text]
dataflowEdges = forall a. Maybe a
Prelude.Nothing,
      $sel:minimumViableContactDurationSeconds:UpdateMissionProfile' :: Maybe Natural
minimumViableContactDurationSeconds =
        forall a. Maybe a
Prelude.Nothing,
      $sel:name:UpdateMissionProfile' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:trackingConfigArn:UpdateMissionProfile' :: Maybe Text
trackingConfigArn = forall a. Maybe a
Prelude.Nothing,
      $sel:missionProfileId:UpdateMissionProfile' :: Text
missionProfileId = Text
pMissionProfileId_
    }

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

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

-- | A list of lists of ARNs. Each list of ARNs is an edge, with a /from/
-- @Config@ and a /to/ @Config@.
updateMissionProfile_dataflowEdges :: Lens.Lens' UpdateMissionProfile (Prelude.Maybe [Prelude.NonEmpty Prelude.Text])
updateMissionProfile_dataflowEdges :: Lens' UpdateMissionProfile (Maybe [NonEmpty Text])
updateMissionProfile_dataflowEdges = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateMissionProfile' {Maybe [NonEmpty Text]
dataflowEdges :: Maybe [NonEmpty Text]
$sel:dataflowEdges:UpdateMissionProfile' :: UpdateMissionProfile -> Maybe [NonEmpty Text]
dataflowEdges} -> Maybe [NonEmpty Text]
dataflowEdges) (\s :: UpdateMissionProfile
s@UpdateMissionProfile' {} Maybe [NonEmpty Text]
a -> UpdateMissionProfile
s {$sel:dataflowEdges:UpdateMissionProfile' :: Maybe [NonEmpty Text]
dataflowEdges = Maybe [NonEmpty Text]
a} :: UpdateMissionProfile) 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

-- | 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.
updateMissionProfile_minimumViableContactDurationSeconds :: Lens.Lens' UpdateMissionProfile (Prelude.Maybe Prelude.Natural)
updateMissionProfile_minimumViableContactDurationSeconds :: Lens' UpdateMissionProfile (Maybe Natural)
updateMissionProfile_minimumViableContactDurationSeconds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateMissionProfile' {Maybe Natural
minimumViableContactDurationSeconds :: Maybe Natural
$sel:minimumViableContactDurationSeconds:UpdateMissionProfile' :: UpdateMissionProfile -> Maybe Natural
minimumViableContactDurationSeconds} -> Maybe Natural
minimumViableContactDurationSeconds) (\s :: UpdateMissionProfile
s@UpdateMissionProfile' {} Maybe Natural
a -> UpdateMissionProfile
s {$sel:minimumViableContactDurationSeconds:UpdateMissionProfile' :: Maybe Natural
minimumViableContactDurationSeconds = Maybe Natural
a} :: UpdateMissionProfile)

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

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

-- | UUID of a mission profile.
updateMissionProfile_missionProfileId :: Lens.Lens' UpdateMissionProfile Prelude.Text
updateMissionProfile_missionProfileId :: Lens' UpdateMissionProfile Text
updateMissionProfile_missionProfileId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateMissionProfile' {Text
missionProfileId :: Text
$sel:missionProfileId:UpdateMissionProfile' :: UpdateMissionProfile -> Text
missionProfileId} -> Text
missionProfileId) (\s :: UpdateMissionProfile
s@UpdateMissionProfile' {} Text
a -> UpdateMissionProfile
s {$sel:missionProfileId:UpdateMissionProfile' :: Text
missionProfileId = Text
a} :: UpdateMissionProfile)

instance Core.AWSRequest UpdateMissionProfile where
  type
    AWSResponse UpdateMissionProfile =
      MissionProfileIdResponse
  request :: (Service -> Service)
-> UpdateMissionProfile -> Request UpdateMissionProfile
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateMissionProfile
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateMissionProfile)))
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 UpdateMissionProfile where
  hashWithSalt :: Int -> UpdateMissionProfile -> Int
hashWithSalt Int
_salt UpdateMissionProfile' {Maybe Natural
Maybe [NonEmpty Text]
Maybe Text
Text
missionProfileId :: Text
trackingConfigArn :: Maybe Text
name :: Maybe Text
minimumViableContactDurationSeconds :: Maybe Natural
dataflowEdges :: Maybe [NonEmpty Text]
contactPrePassDurationSeconds :: Maybe Natural
contactPostPassDurationSeconds :: Maybe Natural
$sel:missionProfileId:UpdateMissionProfile' :: UpdateMissionProfile -> Text
$sel:trackingConfigArn:UpdateMissionProfile' :: UpdateMissionProfile -> Maybe Text
$sel:name:UpdateMissionProfile' :: UpdateMissionProfile -> Maybe Text
$sel:minimumViableContactDurationSeconds:UpdateMissionProfile' :: UpdateMissionProfile -> Maybe Natural
$sel:dataflowEdges:UpdateMissionProfile' :: UpdateMissionProfile -> Maybe [NonEmpty Text]
$sel:contactPrePassDurationSeconds:UpdateMissionProfile' :: UpdateMissionProfile -> Maybe Natural
$sel:contactPostPassDurationSeconds:UpdateMissionProfile' :: UpdateMissionProfile -> 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 [NonEmpty Text]
dataflowEdges
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
minimumViableContactDurationSeconds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
trackingConfigArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
missionProfileId

instance Prelude.NFData UpdateMissionProfile where
  rnf :: UpdateMissionProfile -> ()
rnf UpdateMissionProfile' {Maybe Natural
Maybe [NonEmpty Text]
Maybe Text
Text
missionProfileId :: Text
trackingConfigArn :: Maybe Text
name :: Maybe Text
minimumViableContactDurationSeconds :: Maybe Natural
dataflowEdges :: Maybe [NonEmpty Text]
contactPrePassDurationSeconds :: Maybe Natural
contactPostPassDurationSeconds :: Maybe Natural
$sel:missionProfileId:UpdateMissionProfile' :: UpdateMissionProfile -> Text
$sel:trackingConfigArn:UpdateMissionProfile' :: UpdateMissionProfile -> Maybe Text
$sel:name:UpdateMissionProfile' :: UpdateMissionProfile -> Maybe Text
$sel:minimumViableContactDurationSeconds:UpdateMissionProfile' :: UpdateMissionProfile -> Maybe Natural
$sel:dataflowEdges:UpdateMissionProfile' :: UpdateMissionProfile -> Maybe [NonEmpty Text]
$sel:contactPrePassDurationSeconds:UpdateMissionProfile' :: UpdateMissionProfile -> Maybe Natural
$sel:contactPostPassDurationSeconds:UpdateMissionProfile' :: UpdateMissionProfile -> 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 [NonEmpty Text]
dataflowEdges
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
minimumViableContactDurationSeconds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
trackingConfigArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
missionProfileId

instance Data.ToHeaders UpdateMissionProfile where
  toHeaders :: UpdateMissionProfile -> 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 UpdateMissionProfile where
  toJSON :: UpdateMissionProfile -> Value
toJSON UpdateMissionProfile' {Maybe Natural
Maybe [NonEmpty Text]
Maybe Text
Text
missionProfileId :: Text
trackingConfigArn :: Maybe Text
name :: Maybe Text
minimumViableContactDurationSeconds :: Maybe Natural
dataflowEdges :: Maybe [NonEmpty Text]
contactPrePassDurationSeconds :: Maybe Natural
contactPostPassDurationSeconds :: Maybe Natural
$sel:missionProfileId:UpdateMissionProfile' :: UpdateMissionProfile -> Text
$sel:trackingConfigArn:UpdateMissionProfile' :: UpdateMissionProfile -> Maybe Text
$sel:name:UpdateMissionProfile' :: UpdateMissionProfile -> Maybe Text
$sel:minimumViableContactDurationSeconds:UpdateMissionProfile' :: UpdateMissionProfile -> Maybe Natural
$sel:dataflowEdges:UpdateMissionProfile' :: UpdateMissionProfile -> Maybe [NonEmpty Text]
$sel:contactPrePassDurationSeconds:UpdateMissionProfile' :: UpdateMissionProfile -> Maybe Natural
$sel:contactPostPassDurationSeconds:UpdateMissionProfile' :: UpdateMissionProfile -> 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
"dataflowEdges" 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 [NonEmpty Text]
dataflowEdges,
            (Key
"minimumViableContactDurationSeconds" 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
minimumViableContactDurationSeconds,
            (Key
"name" 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
name,
            (Key
"trackingConfigArn" 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
trackingConfigArn
          ]
      )

instance Data.ToPath UpdateMissionProfile where
  toPath :: UpdateMissionProfile -> ByteString
toPath UpdateMissionProfile' {Maybe Natural
Maybe [NonEmpty Text]
Maybe Text
Text
missionProfileId :: Text
trackingConfigArn :: Maybe Text
name :: Maybe Text
minimumViableContactDurationSeconds :: Maybe Natural
dataflowEdges :: Maybe [NonEmpty Text]
contactPrePassDurationSeconds :: Maybe Natural
contactPostPassDurationSeconds :: Maybe Natural
$sel:missionProfileId:UpdateMissionProfile' :: UpdateMissionProfile -> Text
$sel:trackingConfigArn:UpdateMissionProfile' :: UpdateMissionProfile -> Maybe Text
$sel:name:UpdateMissionProfile' :: UpdateMissionProfile -> Maybe Text
$sel:minimumViableContactDurationSeconds:UpdateMissionProfile' :: UpdateMissionProfile -> Maybe Natural
$sel:dataflowEdges:UpdateMissionProfile' :: UpdateMissionProfile -> Maybe [NonEmpty Text]
$sel:contactPrePassDurationSeconds:UpdateMissionProfile' :: UpdateMissionProfile -> Maybe Natural
$sel:contactPostPassDurationSeconds:UpdateMissionProfile' :: UpdateMissionProfile -> Maybe Natural
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/missionprofile/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
missionProfileId]

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