{-# 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.GameLift.StartFleetActions
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Resumes certain types of activity on fleet instances that were suspended
-- with
-- <https://docs.aws.amazon.com/gamelift/latest/apireference/API_StopFleetActions.html StopFleetActions>.
-- For multi-location fleets, fleet actions are managed separately for each
-- location. Currently, this operation is used to restart a fleet\'s
-- auto-scaling activity.
--
-- This operation can be used in the following ways:
--
-- -   To restart actions on instances in the fleet\'s home Region, provide
--     a fleet ID and the type of actions to resume.
--
-- -   To restart actions on instances in one of the fleet\'s remote
--     locations, provide a fleet ID, a location name, and the type of
--     actions to resume.
--
-- If successful, GameLift once again initiates scaling events as triggered
-- by the fleet\'s scaling policies. If actions on the fleet location were
-- never stopped, this operation will have no effect.
--
-- __Learn more__
--
-- <https://docs.aws.amazon.com/gamelift/latest/developerguide/fleets-intro.html Setting up GameLift fleets>
module Amazonka.GameLift.StartFleetActions
  ( -- * Creating a Request
    StartFleetActions (..),
    newStartFleetActions,

    -- * Request Lenses
    startFleetActions_location,
    startFleetActions_fleetId,
    startFleetActions_actions,

    -- * Destructuring the Response
    StartFleetActionsResponse (..),
    newStartFleetActionsResponse,

    -- * Response Lenses
    startFleetActionsResponse_fleetArn,
    startFleetActionsResponse_fleetId,
    startFleetActionsResponse_httpStatus,
  )
where

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

-- | /See:/ 'newStartFleetActions' smart constructor.
data StartFleetActions = StartFleetActions'
  { -- | The fleet location to restart fleet actions for. Specify a location in
    -- the form of an Amazon Web Services Region code, such as @us-west-2@.
    StartFleetActions -> Maybe Text
location :: Prelude.Maybe Prelude.Text,
    -- | A unique identifier for the fleet to restart actions on. You can use
    -- either the fleet ID or ARN value.
    StartFleetActions -> Text
fleetId :: Prelude.Text,
    -- | List of actions to restart on the fleet.
    StartFleetActions -> NonEmpty FleetAction
actions :: Prelude.NonEmpty FleetAction
  }
  deriving (StartFleetActions -> StartFleetActions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartFleetActions -> StartFleetActions -> Bool
$c/= :: StartFleetActions -> StartFleetActions -> Bool
== :: StartFleetActions -> StartFleetActions -> Bool
$c== :: StartFleetActions -> StartFleetActions -> Bool
Prelude.Eq, ReadPrec [StartFleetActions]
ReadPrec StartFleetActions
Int -> ReadS StartFleetActions
ReadS [StartFleetActions]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartFleetActions]
$creadListPrec :: ReadPrec [StartFleetActions]
readPrec :: ReadPrec StartFleetActions
$creadPrec :: ReadPrec StartFleetActions
readList :: ReadS [StartFleetActions]
$creadList :: ReadS [StartFleetActions]
readsPrec :: Int -> ReadS StartFleetActions
$creadsPrec :: Int -> ReadS StartFleetActions
Prelude.Read, Int -> StartFleetActions -> ShowS
[StartFleetActions] -> ShowS
StartFleetActions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartFleetActions] -> ShowS
$cshowList :: [StartFleetActions] -> ShowS
show :: StartFleetActions -> String
$cshow :: StartFleetActions -> String
showsPrec :: Int -> StartFleetActions -> ShowS
$cshowsPrec :: Int -> StartFleetActions -> ShowS
Prelude.Show, forall x. Rep StartFleetActions x -> StartFleetActions
forall x. StartFleetActions -> Rep StartFleetActions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartFleetActions x -> StartFleetActions
$cfrom :: forall x. StartFleetActions -> Rep StartFleetActions x
Prelude.Generic)

-- |
-- Create a value of 'StartFleetActions' 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:
--
-- 'location', 'startFleetActions_location' - The fleet location to restart fleet actions for. Specify a location in
-- the form of an Amazon Web Services Region code, such as @us-west-2@.
--
-- 'fleetId', 'startFleetActions_fleetId' - A unique identifier for the fleet to restart actions on. You can use
-- either the fleet ID or ARN value.
--
-- 'actions', 'startFleetActions_actions' - List of actions to restart on the fleet.
newStartFleetActions ::
  -- | 'fleetId'
  Prelude.Text ->
  -- | 'actions'
  Prelude.NonEmpty FleetAction ->
  StartFleetActions
newStartFleetActions :: Text -> NonEmpty FleetAction -> StartFleetActions
newStartFleetActions Text
pFleetId_ NonEmpty FleetAction
pActions_ =
  StartFleetActions'
    { $sel:location:StartFleetActions' :: Maybe Text
location = forall a. Maybe a
Prelude.Nothing,
      $sel:fleetId:StartFleetActions' :: Text
fleetId = Text
pFleetId_,
      $sel:actions:StartFleetActions' :: NonEmpty FleetAction
actions = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty FleetAction
pActions_
    }

-- | The fleet location to restart fleet actions for. Specify a location in
-- the form of an Amazon Web Services Region code, such as @us-west-2@.
startFleetActions_location :: Lens.Lens' StartFleetActions (Prelude.Maybe Prelude.Text)
startFleetActions_location :: Lens' StartFleetActions (Maybe Text)
startFleetActions_location = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartFleetActions' {Maybe Text
location :: Maybe Text
$sel:location:StartFleetActions' :: StartFleetActions -> Maybe Text
location} -> Maybe Text
location) (\s :: StartFleetActions
s@StartFleetActions' {} Maybe Text
a -> StartFleetActions
s {$sel:location:StartFleetActions' :: Maybe Text
location = Maybe Text
a} :: StartFleetActions)

-- | A unique identifier for the fleet to restart actions on. You can use
-- either the fleet ID or ARN value.
startFleetActions_fleetId :: Lens.Lens' StartFleetActions Prelude.Text
startFleetActions_fleetId :: Lens' StartFleetActions Text
startFleetActions_fleetId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartFleetActions' {Text
fleetId :: Text
$sel:fleetId:StartFleetActions' :: StartFleetActions -> Text
fleetId} -> Text
fleetId) (\s :: StartFleetActions
s@StartFleetActions' {} Text
a -> StartFleetActions
s {$sel:fleetId:StartFleetActions' :: Text
fleetId = Text
a} :: StartFleetActions)

-- | List of actions to restart on the fleet.
startFleetActions_actions :: Lens.Lens' StartFleetActions (Prelude.NonEmpty FleetAction)
startFleetActions_actions :: Lens' StartFleetActions (NonEmpty FleetAction)
startFleetActions_actions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartFleetActions' {NonEmpty FleetAction
actions :: NonEmpty FleetAction
$sel:actions:StartFleetActions' :: StartFleetActions -> NonEmpty FleetAction
actions} -> NonEmpty FleetAction
actions) (\s :: StartFleetActions
s@StartFleetActions' {} NonEmpty FleetAction
a -> StartFleetActions
s {$sel:actions:StartFleetActions' :: NonEmpty FleetAction
actions = NonEmpty FleetAction
a} :: StartFleetActions) 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

instance Core.AWSRequest StartFleetActions where
  type
    AWSResponse StartFleetActions =
      StartFleetActionsResponse
  request :: (Service -> Service)
-> StartFleetActions -> Request StartFleetActions
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 StartFleetActions
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse StartFleetActions)))
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 Text -> Int -> StartFleetActionsResponse
StartFleetActionsResponse'
            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
"FleetArn")
            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
"FleetId")
            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 StartFleetActions where
  hashWithSalt :: Int -> StartFleetActions -> Int
hashWithSalt Int
_salt StartFleetActions' {Maybe Text
NonEmpty FleetAction
Text
actions :: NonEmpty FleetAction
fleetId :: Text
location :: Maybe Text
$sel:actions:StartFleetActions' :: StartFleetActions -> NonEmpty FleetAction
$sel:fleetId:StartFleetActions' :: StartFleetActions -> Text
$sel:location:StartFleetActions' :: StartFleetActions -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
location
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
fleetId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty FleetAction
actions

instance Prelude.NFData StartFleetActions where
  rnf :: StartFleetActions -> ()
rnf StartFleetActions' {Maybe Text
NonEmpty FleetAction
Text
actions :: NonEmpty FleetAction
fleetId :: Text
location :: Maybe Text
$sel:actions:StartFleetActions' :: StartFleetActions -> NonEmpty FleetAction
$sel:fleetId:StartFleetActions' :: StartFleetActions -> Text
$sel:location:StartFleetActions' :: StartFleetActions -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
location
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
fleetId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty FleetAction
actions

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

instance Data.ToJSON StartFleetActions where
  toJSON :: StartFleetActions -> Value
toJSON StartFleetActions' {Maybe Text
NonEmpty FleetAction
Text
actions :: NonEmpty FleetAction
fleetId :: Text
location :: Maybe Text
$sel:actions:StartFleetActions' :: StartFleetActions -> NonEmpty FleetAction
$sel:fleetId:StartFleetActions' :: StartFleetActions -> Text
$sel:location:StartFleetActions' :: StartFleetActions -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Location" 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
location,
            forall a. a -> Maybe a
Prelude.Just (Key
"FleetId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
fleetId),
            forall a. a -> Maybe a
Prelude.Just (Key
"Actions" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty FleetAction
actions)
          ]
      )

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

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

-- | /See:/ 'newStartFleetActionsResponse' smart constructor.
data StartFleetActionsResponse = StartFleetActionsResponse'
  { -- | The Amazon Resource Name
    -- (<https://docs.aws.amazon.com/AmazonS3/latest/dev/s3-arn-format.html ARN>)
    -- that is assigned to a GameLift fleet resource and uniquely identifies
    -- it. ARNs are unique across all Regions. Format is
    -- @arn:aws:gamelift:\<region>::fleet\/fleet-a1234567-b8c9-0d1e-2fa3-b45c6d7e8912@.
    StartFleetActionsResponse -> Maybe Text
fleetArn :: Prelude.Maybe Prelude.Text,
    -- | A unique identifier for the fleet to restart actions on.
    StartFleetActionsResponse -> Maybe Text
fleetId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    StartFleetActionsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (StartFleetActionsResponse -> StartFleetActionsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartFleetActionsResponse -> StartFleetActionsResponse -> Bool
$c/= :: StartFleetActionsResponse -> StartFleetActionsResponse -> Bool
== :: StartFleetActionsResponse -> StartFleetActionsResponse -> Bool
$c== :: StartFleetActionsResponse -> StartFleetActionsResponse -> Bool
Prelude.Eq, ReadPrec [StartFleetActionsResponse]
ReadPrec StartFleetActionsResponse
Int -> ReadS StartFleetActionsResponse
ReadS [StartFleetActionsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartFleetActionsResponse]
$creadListPrec :: ReadPrec [StartFleetActionsResponse]
readPrec :: ReadPrec StartFleetActionsResponse
$creadPrec :: ReadPrec StartFleetActionsResponse
readList :: ReadS [StartFleetActionsResponse]
$creadList :: ReadS [StartFleetActionsResponse]
readsPrec :: Int -> ReadS StartFleetActionsResponse
$creadsPrec :: Int -> ReadS StartFleetActionsResponse
Prelude.Read, Int -> StartFleetActionsResponse -> ShowS
[StartFleetActionsResponse] -> ShowS
StartFleetActionsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartFleetActionsResponse] -> ShowS
$cshowList :: [StartFleetActionsResponse] -> ShowS
show :: StartFleetActionsResponse -> String
$cshow :: StartFleetActionsResponse -> String
showsPrec :: Int -> StartFleetActionsResponse -> ShowS
$cshowsPrec :: Int -> StartFleetActionsResponse -> ShowS
Prelude.Show, forall x.
Rep StartFleetActionsResponse x -> StartFleetActionsResponse
forall x.
StartFleetActionsResponse -> Rep StartFleetActionsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep StartFleetActionsResponse x -> StartFleetActionsResponse
$cfrom :: forall x.
StartFleetActionsResponse -> Rep StartFleetActionsResponse x
Prelude.Generic)

-- |
-- Create a value of 'StartFleetActionsResponse' 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:
--
-- 'fleetArn', 'startFleetActionsResponse_fleetArn' - The Amazon Resource Name
-- (<https://docs.aws.amazon.com/AmazonS3/latest/dev/s3-arn-format.html ARN>)
-- that is assigned to a GameLift fleet resource and uniquely identifies
-- it. ARNs are unique across all Regions. Format is
-- @arn:aws:gamelift:\<region>::fleet\/fleet-a1234567-b8c9-0d1e-2fa3-b45c6d7e8912@.
--
-- 'fleetId', 'startFleetActionsResponse_fleetId' - A unique identifier for the fleet to restart actions on.
--
-- 'httpStatus', 'startFleetActionsResponse_httpStatus' - The response's http status code.
newStartFleetActionsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  StartFleetActionsResponse
newStartFleetActionsResponse :: Int -> StartFleetActionsResponse
newStartFleetActionsResponse Int
pHttpStatus_ =
  StartFleetActionsResponse'
    { $sel:fleetArn:StartFleetActionsResponse' :: Maybe Text
fleetArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:fleetId:StartFleetActionsResponse' :: Maybe Text
fleetId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:StartFleetActionsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name
-- (<https://docs.aws.amazon.com/AmazonS3/latest/dev/s3-arn-format.html ARN>)
-- that is assigned to a GameLift fleet resource and uniquely identifies
-- it. ARNs are unique across all Regions. Format is
-- @arn:aws:gamelift:\<region>::fleet\/fleet-a1234567-b8c9-0d1e-2fa3-b45c6d7e8912@.
startFleetActionsResponse_fleetArn :: Lens.Lens' StartFleetActionsResponse (Prelude.Maybe Prelude.Text)
startFleetActionsResponse_fleetArn :: Lens' StartFleetActionsResponse (Maybe Text)
startFleetActionsResponse_fleetArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartFleetActionsResponse' {Maybe Text
fleetArn :: Maybe Text
$sel:fleetArn:StartFleetActionsResponse' :: StartFleetActionsResponse -> Maybe Text
fleetArn} -> Maybe Text
fleetArn) (\s :: StartFleetActionsResponse
s@StartFleetActionsResponse' {} Maybe Text
a -> StartFleetActionsResponse
s {$sel:fleetArn:StartFleetActionsResponse' :: Maybe Text
fleetArn = Maybe Text
a} :: StartFleetActionsResponse)

-- | A unique identifier for the fleet to restart actions on.
startFleetActionsResponse_fleetId :: Lens.Lens' StartFleetActionsResponse (Prelude.Maybe Prelude.Text)
startFleetActionsResponse_fleetId :: Lens' StartFleetActionsResponse (Maybe Text)
startFleetActionsResponse_fleetId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartFleetActionsResponse' {Maybe Text
fleetId :: Maybe Text
$sel:fleetId:StartFleetActionsResponse' :: StartFleetActionsResponse -> Maybe Text
fleetId} -> Maybe Text
fleetId) (\s :: StartFleetActionsResponse
s@StartFleetActionsResponse' {} Maybe Text
a -> StartFleetActionsResponse
s {$sel:fleetId:StartFleetActionsResponse' :: Maybe Text
fleetId = Maybe Text
a} :: StartFleetActionsResponse)

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

instance Prelude.NFData StartFleetActionsResponse where
  rnf :: StartFleetActionsResponse -> ()
rnf StartFleetActionsResponse' {Int
Maybe Text
httpStatus :: Int
fleetId :: Maybe Text
fleetArn :: Maybe Text
$sel:httpStatus:StartFleetActionsResponse' :: StartFleetActionsResponse -> Int
$sel:fleetId:StartFleetActionsResponse' :: StartFleetActionsResponse -> Maybe Text
$sel:fleetArn:StartFleetActionsResponse' :: StartFleetActionsResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
fleetArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
fleetId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus