{-# 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.RobOMaker.Types.BatchPolicy
-- 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.RobOMaker.Types.BatchPolicy where

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

-- | Information about the batch policy.
--
-- /See:/ 'newBatchPolicy' smart constructor.
data BatchPolicy = BatchPolicy'
  { -- | The number of active simulation jobs create as part of the batch that
    -- can be in an active state at the same time.
    --
    -- Active states include: @Pending@,@Preparing@, @Running@, @Restarting@,
    -- @RunningFailed@ and @Terminating@. All other states are terminal states.
    BatchPolicy -> Maybe Int
maxConcurrency :: Prelude.Maybe Prelude.Int,
    -- | The amount of time, in seconds, to wait for the batch to complete.
    --
    -- If a batch times out, and there are pending requests that were failing
    -- due to an internal failure (like @InternalServiceError@), they will be
    -- moved to the failed list and the batch status will be @Failed@. If the
    -- pending requests were failing for any other reason, the failed pending
    -- requests will be moved to the failed list and the batch status will be
    -- @TimedOut@.
    BatchPolicy -> Maybe Integer
timeoutInSeconds :: Prelude.Maybe Prelude.Integer
  }
  deriving (BatchPolicy -> BatchPolicy -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchPolicy -> BatchPolicy -> Bool
$c/= :: BatchPolicy -> BatchPolicy -> Bool
== :: BatchPolicy -> BatchPolicy -> Bool
$c== :: BatchPolicy -> BatchPolicy -> Bool
Prelude.Eq, ReadPrec [BatchPolicy]
ReadPrec BatchPolicy
Int -> ReadS BatchPolicy
ReadS [BatchPolicy]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchPolicy]
$creadListPrec :: ReadPrec [BatchPolicy]
readPrec :: ReadPrec BatchPolicy
$creadPrec :: ReadPrec BatchPolicy
readList :: ReadS [BatchPolicy]
$creadList :: ReadS [BatchPolicy]
readsPrec :: Int -> ReadS BatchPolicy
$creadsPrec :: Int -> ReadS BatchPolicy
Prelude.Read, Int -> BatchPolicy -> ShowS
[BatchPolicy] -> ShowS
BatchPolicy -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchPolicy] -> ShowS
$cshowList :: [BatchPolicy] -> ShowS
show :: BatchPolicy -> String
$cshow :: BatchPolicy -> String
showsPrec :: Int -> BatchPolicy -> ShowS
$cshowsPrec :: Int -> BatchPolicy -> ShowS
Prelude.Show, forall x. Rep BatchPolicy x -> BatchPolicy
forall x. BatchPolicy -> Rep BatchPolicy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BatchPolicy x -> BatchPolicy
$cfrom :: forall x. BatchPolicy -> Rep BatchPolicy x
Prelude.Generic)

-- |
-- Create a value of 'BatchPolicy' 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:
--
-- 'maxConcurrency', 'batchPolicy_maxConcurrency' - The number of active simulation jobs create as part of the batch that
-- can be in an active state at the same time.
--
-- Active states include: @Pending@,@Preparing@, @Running@, @Restarting@,
-- @RunningFailed@ and @Terminating@. All other states are terminal states.
--
-- 'timeoutInSeconds', 'batchPolicy_timeoutInSeconds' - The amount of time, in seconds, to wait for the batch to complete.
--
-- If a batch times out, and there are pending requests that were failing
-- due to an internal failure (like @InternalServiceError@), they will be
-- moved to the failed list and the batch status will be @Failed@. If the
-- pending requests were failing for any other reason, the failed pending
-- requests will be moved to the failed list and the batch status will be
-- @TimedOut@.
newBatchPolicy ::
  BatchPolicy
newBatchPolicy :: BatchPolicy
newBatchPolicy =
  BatchPolicy'
    { $sel:maxConcurrency:BatchPolicy' :: Maybe Int
maxConcurrency = forall a. Maybe a
Prelude.Nothing,
      $sel:timeoutInSeconds:BatchPolicy' :: Maybe Integer
timeoutInSeconds = forall a. Maybe a
Prelude.Nothing
    }

-- | The number of active simulation jobs create as part of the batch that
-- can be in an active state at the same time.
--
-- Active states include: @Pending@,@Preparing@, @Running@, @Restarting@,
-- @RunningFailed@ and @Terminating@. All other states are terminal states.
batchPolicy_maxConcurrency :: Lens.Lens' BatchPolicy (Prelude.Maybe Prelude.Int)
batchPolicy_maxConcurrency :: Lens' BatchPolicy (Maybe Int)
batchPolicy_maxConcurrency = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchPolicy' {Maybe Int
maxConcurrency :: Maybe Int
$sel:maxConcurrency:BatchPolicy' :: BatchPolicy -> Maybe Int
maxConcurrency} -> Maybe Int
maxConcurrency) (\s :: BatchPolicy
s@BatchPolicy' {} Maybe Int
a -> BatchPolicy
s {$sel:maxConcurrency:BatchPolicy' :: Maybe Int
maxConcurrency = Maybe Int
a} :: BatchPolicy)

-- | The amount of time, in seconds, to wait for the batch to complete.
--
-- If a batch times out, and there are pending requests that were failing
-- due to an internal failure (like @InternalServiceError@), they will be
-- moved to the failed list and the batch status will be @Failed@. If the
-- pending requests were failing for any other reason, the failed pending
-- requests will be moved to the failed list and the batch status will be
-- @TimedOut@.
batchPolicy_timeoutInSeconds :: Lens.Lens' BatchPolicy (Prelude.Maybe Prelude.Integer)
batchPolicy_timeoutInSeconds :: Lens' BatchPolicy (Maybe Integer)
batchPolicy_timeoutInSeconds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchPolicy' {Maybe Integer
timeoutInSeconds :: Maybe Integer
$sel:timeoutInSeconds:BatchPolicy' :: BatchPolicy -> Maybe Integer
timeoutInSeconds} -> Maybe Integer
timeoutInSeconds) (\s :: BatchPolicy
s@BatchPolicy' {} Maybe Integer
a -> BatchPolicy
s {$sel:timeoutInSeconds:BatchPolicy' :: Maybe Integer
timeoutInSeconds = Maybe Integer
a} :: BatchPolicy)

instance Data.FromJSON BatchPolicy where
  parseJSON :: Value -> Parser BatchPolicy
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"BatchPolicy"
      ( \Object
x ->
          Maybe Int -> Maybe Integer -> BatchPolicy
BatchPolicy'
            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
"maxConcurrency")
            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
"timeoutInSeconds")
      )

instance Prelude.Hashable BatchPolicy where
  hashWithSalt :: Int -> BatchPolicy -> Int
hashWithSalt Int
_salt BatchPolicy' {Maybe Int
Maybe Integer
timeoutInSeconds :: Maybe Integer
maxConcurrency :: Maybe Int
$sel:timeoutInSeconds:BatchPolicy' :: BatchPolicy -> Maybe Integer
$sel:maxConcurrency:BatchPolicy' :: BatchPolicy -> Maybe Int
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
maxConcurrency
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Integer
timeoutInSeconds

instance Prelude.NFData BatchPolicy where
  rnf :: BatchPolicy -> ()
rnf BatchPolicy' {Maybe Int
Maybe Integer
timeoutInSeconds :: Maybe Integer
maxConcurrency :: Maybe Int
$sel:timeoutInSeconds:BatchPolicy' :: BatchPolicy -> Maybe Integer
$sel:maxConcurrency:BatchPolicy' :: BatchPolicy -> Maybe Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
maxConcurrency
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Integer
timeoutInSeconds

instance Data.ToJSON BatchPolicy where
  toJSON :: BatchPolicy -> Value
toJSON BatchPolicy' {Maybe Int
Maybe Integer
timeoutInSeconds :: Maybe Integer
maxConcurrency :: Maybe Int
$sel:timeoutInSeconds:BatchPolicy' :: BatchPolicy -> Maybe Integer
$sel:maxConcurrency:BatchPolicy' :: BatchPolicy -> Maybe Int
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"maxConcurrency" 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
maxConcurrency,
            (Key
"timeoutInSeconds" 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 Integer
timeoutInSeconds
          ]
      )