{-# 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.Batch.CreateJobQueue
-- 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 an Batch job queue. When you create a job queue, you associate
-- one or more compute environments to the queue and assign an order of
-- preference for the compute environments.
--
-- You also set a priority to the job queue that determines the order that
-- the Batch scheduler places jobs onto its associated compute
-- environments. For example, if a compute environment is associated with
-- more than one job queue, the job queue with a higher priority is given
-- preference for scheduling jobs to that compute environment.
module Amazonka.Batch.CreateJobQueue
  ( -- * Creating a Request
    CreateJobQueue (..),
    newCreateJobQueue,

    -- * Request Lenses
    createJobQueue_schedulingPolicyArn,
    createJobQueue_state,
    createJobQueue_tags,
    createJobQueue_jobQueueName,
    createJobQueue_priority,
    createJobQueue_computeEnvironmentOrder,

    -- * Destructuring the Response
    CreateJobQueueResponse (..),
    newCreateJobQueueResponse,

    -- * Response Lenses
    createJobQueueResponse_httpStatus,
    createJobQueueResponse_jobQueueName,
    createJobQueueResponse_jobQueueArn,
  )
where

import Amazonka.Batch.Types
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
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | Contains the parameters for @CreateJobQueue@.
--
-- /See:/ 'newCreateJobQueue' smart constructor.
data CreateJobQueue = CreateJobQueue'
  { -- | The Amazon Resource Name (ARN) of the fair share scheduling policy. If
    -- this parameter is specified, the job queue uses a fair share scheduling
    -- policy. If this parameter isn\'t specified, the job queue uses a first
    -- in, first out (FIFO) scheduling policy. After a job queue is created,
    -- you can replace but can\'t remove the fair share scheduling policy. The
    -- format is
    -- @aws:@/@Partition@/@:batch:@/@Region@/@:@/@Account@/@:scheduling-policy\/@/@Name@/@ @.
    -- An example is
    -- @aws:aws:batch:us-west-2:123456789012:scheduling-policy\/MySchedulingPolicy@.
    CreateJobQueue -> Maybe Text
schedulingPolicyArn :: Prelude.Maybe Prelude.Text,
    -- | The state of the job queue. If the job queue state is @ENABLED@, it is
    -- able to accept jobs. If the job queue state is @DISABLED@, new jobs
    -- can\'t be added to the queue, but jobs already in the queue can finish.
    CreateJobQueue -> Maybe JQState
state :: Prelude.Maybe JQState,
    -- | The tags that you apply to the job queue to help you categorize and
    -- organize your resources. Each tag consists of a key and an optional
    -- value. For more information, see
    -- <https://docs.aws.amazon.com/batch/latest/userguide/using-tags.html Tagging your Batch resources>
    -- in /Batch User Guide/.
    CreateJobQueue -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The name of the job queue. It can be up to 128 letters long. It can
    -- contain uppercase and lowercase letters, numbers, hyphens (-), and
    -- underscores (_).
    CreateJobQueue -> Text
jobQueueName :: Prelude.Text,
    -- | The priority of the job queue. Job queues with a higher priority (or a
    -- higher integer value for the @priority@ parameter) are evaluated first
    -- when associated with the same compute environment. Priority is
    -- determined in descending order. For example, a job queue with a priority
    -- value of @10@ is given scheduling preference over a job queue with a
    -- priority value of @1@. All of the compute environments must be either
    -- EC2 (@EC2@ or @SPOT@) or Fargate (@FARGATE@ or @FARGATE_SPOT@); EC2 and
    -- Fargate compute environments can\'t be mixed.
    CreateJobQueue -> Int
priority :: Prelude.Int,
    -- | The set of compute environments mapped to a job queue and their order
    -- relative to each other. The job scheduler uses this parameter to
    -- determine which compute environment runs a specific job. Compute
    -- environments must be in the @VALID@ state before you can associate them
    -- with a job queue. You can associate up to three compute environments
    -- with a job queue. All of the compute environments must be either EC2
    -- (@EC2@ or @SPOT@) or Fargate (@FARGATE@ or @FARGATE_SPOT@); EC2 and
    -- Fargate compute environments can\'t be mixed.
    --
    -- All compute environments that are associated with a job queue must share
    -- the same architecture. Batch doesn\'t support mixing compute environment
    -- architecture types in a single job queue.
    CreateJobQueue -> [ComputeEnvironmentOrder]
computeEnvironmentOrder :: [ComputeEnvironmentOrder]
  }
  deriving (CreateJobQueue -> CreateJobQueue -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateJobQueue -> CreateJobQueue -> Bool
$c/= :: CreateJobQueue -> CreateJobQueue -> Bool
== :: CreateJobQueue -> CreateJobQueue -> Bool
$c== :: CreateJobQueue -> CreateJobQueue -> Bool
Prelude.Eq, ReadPrec [CreateJobQueue]
ReadPrec CreateJobQueue
Int -> ReadS CreateJobQueue
ReadS [CreateJobQueue]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateJobQueue]
$creadListPrec :: ReadPrec [CreateJobQueue]
readPrec :: ReadPrec CreateJobQueue
$creadPrec :: ReadPrec CreateJobQueue
readList :: ReadS [CreateJobQueue]
$creadList :: ReadS [CreateJobQueue]
readsPrec :: Int -> ReadS CreateJobQueue
$creadsPrec :: Int -> ReadS CreateJobQueue
Prelude.Read, Int -> CreateJobQueue -> ShowS
[CreateJobQueue] -> ShowS
CreateJobQueue -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateJobQueue] -> ShowS
$cshowList :: [CreateJobQueue] -> ShowS
show :: CreateJobQueue -> String
$cshow :: CreateJobQueue -> String
showsPrec :: Int -> CreateJobQueue -> ShowS
$cshowsPrec :: Int -> CreateJobQueue -> ShowS
Prelude.Show, forall x. Rep CreateJobQueue x -> CreateJobQueue
forall x. CreateJobQueue -> Rep CreateJobQueue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateJobQueue x -> CreateJobQueue
$cfrom :: forall x. CreateJobQueue -> Rep CreateJobQueue x
Prelude.Generic)

-- |
-- Create a value of 'CreateJobQueue' 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:
--
-- 'schedulingPolicyArn', 'createJobQueue_schedulingPolicyArn' - The Amazon Resource Name (ARN) of the fair share scheduling policy. If
-- this parameter is specified, the job queue uses a fair share scheduling
-- policy. If this parameter isn\'t specified, the job queue uses a first
-- in, first out (FIFO) scheduling policy. After a job queue is created,
-- you can replace but can\'t remove the fair share scheduling policy. The
-- format is
-- @aws:@/@Partition@/@:batch:@/@Region@/@:@/@Account@/@:scheduling-policy\/@/@Name@/@ @.
-- An example is
-- @aws:aws:batch:us-west-2:123456789012:scheduling-policy\/MySchedulingPolicy@.
--
-- 'state', 'createJobQueue_state' - The state of the job queue. If the job queue state is @ENABLED@, it is
-- able to accept jobs. If the job queue state is @DISABLED@, new jobs
-- can\'t be added to the queue, but jobs already in the queue can finish.
--
-- 'tags', 'createJobQueue_tags' - The tags that you apply to the job queue to help you categorize and
-- organize your resources. Each tag consists of a key and an optional
-- value. For more information, see
-- <https://docs.aws.amazon.com/batch/latest/userguide/using-tags.html Tagging your Batch resources>
-- in /Batch User Guide/.
--
-- 'jobQueueName', 'createJobQueue_jobQueueName' - The name of the job queue. It can be up to 128 letters long. It can
-- contain uppercase and lowercase letters, numbers, hyphens (-), and
-- underscores (_).
--
-- 'priority', 'createJobQueue_priority' - The priority of the job queue. Job queues with a higher priority (or a
-- higher integer value for the @priority@ parameter) are evaluated first
-- when associated with the same compute environment. Priority is
-- determined in descending order. For example, a job queue with a priority
-- value of @10@ is given scheduling preference over a job queue with a
-- priority value of @1@. All of the compute environments must be either
-- EC2 (@EC2@ or @SPOT@) or Fargate (@FARGATE@ or @FARGATE_SPOT@); EC2 and
-- Fargate compute environments can\'t be mixed.
--
-- 'computeEnvironmentOrder', 'createJobQueue_computeEnvironmentOrder' - The set of compute environments mapped to a job queue and their order
-- relative to each other. The job scheduler uses this parameter to
-- determine which compute environment runs a specific job. Compute
-- environments must be in the @VALID@ state before you can associate them
-- with a job queue. You can associate up to three compute environments
-- with a job queue. All of the compute environments must be either EC2
-- (@EC2@ or @SPOT@) or Fargate (@FARGATE@ or @FARGATE_SPOT@); EC2 and
-- Fargate compute environments can\'t be mixed.
--
-- All compute environments that are associated with a job queue must share
-- the same architecture. Batch doesn\'t support mixing compute environment
-- architecture types in a single job queue.
newCreateJobQueue ::
  -- | 'jobQueueName'
  Prelude.Text ->
  -- | 'priority'
  Prelude.Int ->
  CreateJobQueue
newCreateJobQueue :: Text -> Int -> CreateJobQueue
newCreateJobQueue Text
pJobQueueName_ Int
pPriority_ =
  CreateJobQueue'
    { $sel:schedulingPolicyArn:CreateJobQueue' :: Maybe Text
schedulingPolicyArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:state:CreateJobQueue' :: Maybe JQState
state = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateJobQueue' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:jobQueueName:CreateJobQueue' :: Text
jobQueueName = Text
pJobQueueName_,
      $sel:priority:CreateJobQueue' :: Int
priority = Int
pPriority_,
      $sel:computeEnvironmentOrder:CreateJobQueue' :: [ComputeEnvironmentOrder]
computeEnvironmentOrder = forall a. Monoid a => a
Prelude.mempty
    }

-- | The Amazon Resource Name (ARN) of the fair share scheduling policy. If
-- this parameter is specified, the job queue uses a fair share scheduling
-- policy. If this parameter isn\'t specified, the job queue uses a first
-- in, first out (FIFO) scheduling policy. After a job queue is created,
-- you can replace but can\'t remove the fair share scheduling policy. The
-- format is
-- @aws:@/@Partition@/@:batch:@/@Region@/@:@/@Account@/@:scheduling-policy\/@/@Name@/@ @.
-- An example is
-- @aws:aws:batch:us-west-2:123456789012:scheduling-policy\/MySchedulingPolicy@.
createJobQueue_schedulingPolicyArn :: Lens.Lens' CreateJobQueue (Prelude.Maybe Prelude.Text)
createJobQueue_schedulingPolicyArn :: Lens' CreateJobQueue (Maybe Text)
createJobQueue_schedulingPolicyArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJobQueue' {Maybe Text
schedulingPolicyArn :: Maybe Text
$sel:schedulingPolicyArn:CreateJobQueue' :: CreateJobQueue -> Maybe Text
schedulingPolicyArn} -> Maybe Text
schedulingPolicyArn) (\s :: CreateJobQueue
s@CreateJobQueue' {} Maybe Text
a -> CreateJobQueue
s {$sel:schedulingPolicyArn:CreateJobQueue' :: Maybe Text
schedulingPolicyArn = Maybe Text
a} :: CreateJobQueue)

-- | The state of the job queue. If the job queue state is @ENABLED@, it is
-- able to accept jobs. If the job queue state is @DISABLED@, new jobs
-- can\'t be added to the queue, but jobs already in the queue can finish.
createJobQueue_state :: Lens.Lens' CreateJobQueue (Prelude.Maybe JQState)
createJobQueue_state :: Lens' CreateJobQueue (Maybe JQState)
createJobQueue_state = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJobQueue' {Maybe JQState
state :: Maybe JQState
$sel:state:CreateJobQueue' :: CreateJobQueue -> Maybe JQState
state} -> Maybe JQState
state) (\s :: CreateJobQueue
s@CreateJobQueue' {} Maybe JQState
a -> CreateJobQueue
s {$sel:state:CreateJobQueue' :: Maybe JQState
state = Maybe JQState
a} :: CreateJobQueue)

-- | The tags that you apply to the job queue to help you categorize and
-- organize your resources. Each tag consists of a key and an optional
-- value. For more information, see
-- <https://docs.aws.amazon.com/batch/latest/userguide/using-tags.html Tagging your Batch resources>
-- in /Batch User Guide/.
createJobQueue_tags :: Lens.Lens' CreateJobQueue (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createJobQueue_tags :: Lens' CreateJobQueue (Maybe (HashMap Text Text))
createJobQueue_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJobQueue' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateJobQueue' :: CreateJobQueue -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateJobQueue
s@CreateJobQueue' {} Maybe (HashMap Text Text)
a -> CreateJobQueue
s {$sel:tags:CreateJobQueue' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateJobQueue) 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

-- | The name of the job queue. It can be up to 128 letters long. It can
-- contain uppercase and lowercase letters, numbers, hyphens (-), and
-- underscores (_).
createJobQueue_jobQueueName :: Lens.Lens' CreateJobQueue Prelude.Text
createJobQueue_jobQueueName :: Lens' CreateJobQueue Text
createJobQueue_jobQueueName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJobQueue' {Text
jobQueueName :: Text
$sel:jobQueueName:CreateJobQueue' :: CreateJobQueue -> Text
jobQueueName} -> Text
jobQueueName) (\s :: CreateJobQueue
s@CreateJobQueue' {} Text
a -> CreateJobQueue
s {$sel:jobQueueName:CreateJobQueue' :: Text
jobQueueName = Text
a} :: CreateJobQueue)

-- | The priority of the job queue. Job queues with a higher priority (or a
-- higher integer value for the @priority@ parameter) are evaluated first
-- when associated with the same compute environment. Priority is
-- determined in descending order. For example, a job queue with a priority
-- value of @10@ is given scheduling preference over a job queue with a
-- priority value of @1@. All of the compute environments must be either
-- EC2 (@EC2@ or @SPOT@) or Fargate (@FARGATE@ or @FARGATE_SPOT@); EC2 and
-- Fargate compute environments can\'t be mixed.
createJobQueue_priority :: Lens.Lens' CreateJobQueue Prelude.Int
createJobQueue_priority :: Lens' CreateJobQueue Int
createJobQueue_priority = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJobQueue' {Int
priority :: Int
$sel:priority:CreateJobQueue' :: CreateJobQueue -> Int
priority} -> Int
priority) (\s :: CreateJobQueue
s@CreateJobQueue' {} Int
a -> CreateJobQueue
s {$sel:priority:CreateJobQueue' :: Int
priority = Int
a} :: CreateJobQueue)

-- | The set of compute environments mapped to a job queue and their order
-- relative to each other. The job scheduler uses this parameter to
-- determine which compute environment runs a specific job. Compute
-- environments must be in the @VALID@ state before you can associate them
-- with a job queue. You can associate up to three compute environments
-- with a job queue. All of the compute environments must be either EC2
-- (@EC2@ or @SPOT@) or Fargate (@FARGATE@ or @FARGATE_SPOT@); EC2 and
-- Fargate compute environments can\'t be mixed.
--
-- All compute environments that are associated with a job queue must share
-- the same architecture. Batch doesn\'t support mixing compute environment
-- architecture types in a single job queue.
createJobQueue_computeEnvironmentOrder :: Lens.Lens' CreateJobQueue [ComputeEnvironmentOrder]
createJobQueue_computeEnvironmentOrder :: Lens' CreateJobQueue [ComputeEnvironmentOrder]
createJobQueue_computeEnvironmentOrder = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJobQueue' {[ComputeEnvironmentOrder]
computeEnvironmentOrder :: [ComputeEnvironmentOrder]
$sel:computeEnvironmentOrder:CreateJobQueue' :: CreateJobQueue -> [ComputeEnvironmentOrder]
computeEnvironmentOrder} -> [ComputeEnvironmentOrder]
computeEnvironmentOrder) (\s :: CreateJobQueue
s@CreateJobQueue' {} [ComputeEnvironmentOrder]
a -> CreateJobQueue
s {$sel:computeEnvironmentOrder:CreateJobQueue' :: [ComputeEnvironmentOrder]
computeEnvironmentOrder = [ComputeEnvironmentOrder]
a} :: CreateJobQueue) 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 CreateJobQueue where
  type
    AWSResponse CreateJobQueue =
      CreateJobQueueResponse
  request :: (Service -> Service) -> CreateJobQueue -> Request CreateJobQueue
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 CreateJobQueue
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateJobQueue)))
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 ->
          Int -> Text -> Text -> CreateJobQueueResponse
CreateJobQueueResponse'
            forall (f :: * -> *) a b. Functor 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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"jobQueueName")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"jobQueueArn")
      )

instance Prelude.Hashable CreateJobQueue where
  hashWithSalt :: Int -> CreateJobQueue -> Int
hashWithSalt Int
_salt CreateJobQueue' {Int
[ComputeEnvironmentOrder]
Maybe Text
Maybe (HashMap Text Text)
Maybe JQState
Text
computeEnvironmentOrder :: [ComputeEnvironmentOrder]
priority :: Int
jobQueueName :: Text
tags :: Maybe (HashMap Text Text)
state :: Maybe JQState
schedulingPolicyArn :: Maybe Text
$sel:computeEnvironmentOrder:CreateJobQueue' :: CreateJobQueue -> [ComputeEnvironmentOrder]
$sel:priority:CreateJobQueue' :: CreateJobQueue -> Int
$sel:jobQueueName:CreateJobQueue' :: CreateJobQueue -> Text
$sel:tags:CreateJobQueue' :: CreateJobQueue -> Maybe (HashMap Text Text)
$sel:state:CreateJobQueue' :: CreateJobQueue -> Maybe JQState
$sel:schedulingPolicyArn:CreateJobQueue' :: CreateJobQueue -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
schedulingPolicyArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe JQState
state
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
jobQueueName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Int
priority
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [ComputeEnvironmentOrder]
computeEnvironmentOrder

instance Prelude.NFData CreateJobQueue where
  rnf :: CreateJobQueue -> ()
rnf CreateJobQueue' {Int
[ComputeEnvironmentOrder]
Maybe Text
Maybe (HashMap Text Text)
Maybe JQState
Text
computeEnvironmentOrder :: [ComputeEnvironmentOrder]
priority :: Int
jobQueueName :: Text
tags :: Maybe (HashMap Text Text)
state :: Maybe JQState
schedulingPolicyArn :: Maybe Text
$sel:computeEnvironmentOrder:CreateJobQueue' :: CreateJobQueue -> [ComputeEnvironmentOrder]
$sel:priority:CreateJobQueue' :: CreateJobQueue -> Int
$sel:jobQueueName:CreateJobQueue' :: CreateJobQueue -> Text
$sel:tags:CreateJobQueue' :: CreateJobQueue -> Maybe (HashMap Text Text)
$sel:state:CreateJobQueue' :: CreateJobQueue -> Maybe JQState
$sel:schedulingPolicyArn:CreateJobQueue' :: CreateJobQueue -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
schedulingPolicyArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe JQState
state
      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 Text
jobQueueName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
priority
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [ComputeEnvironmentOrder]
computeEnvironmentOrder

instance Data.ToHeaders CreateJobQueue where
  toHeaders :: CreateJobQueue -> 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 CreateJobQueue where
  toJSON :: CreateJobQueue -> Value
toJSON CreateJobQueue' {Int
[ComputeEnvironmentOrder]
Maybe Text
Maybe (HashMap Text Text)
Maybe JQState
Text
computeEnvironmentOrder :: [ComputeEnvironmentOrder]
priority :: Int
jobQueueName :: Text
tags :: Maybe (HashMap Text Text)
state :: Maybe JQState
schedulingPolicyArn :: Maybe Text
$sel:computeEnvironmentOrder:CreateJobQueue' :: CreateJobQueue -> [ComputeEnvironmentOrder]
$sel:priority:CreateJobQueue' :: CreateJobQueue -> Int
$sel:jobQueueName:CreateJobQueue' :: CreateJobQueue -> Text
$sel:tags:CreateJobQueue' :: CreateJobQueue -> Maybe (HashMap Text Text)
$sel:state:CreateJobQueue' :: CreateJobQueue -> Maybe JQState
$sel:schedulingPolicyArn:CreateJobQueue' :: CreateJobQueue -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"schedulingPolicyArn" 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
schedulingPolicyArn,
            (Key
"state" 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 JQState
state,
            (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
"jobQueueName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
jobQueueName),
            forall a. a -> Maybe a
Prelude.Just (Key
"priority" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Int
priority),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"computeEnvironmentOrder"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [ComputeEnvironmentOrder]
computeEnvironmentOrder
              )
          ]
      )

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

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

-- | /See:/ 'newCreateJobQueueResponse' smart constructor.
data CreateJobQueueResponse = CreateJobQueueResponse'
  { -- | The response's http status code.
    CreateJobQueueResponse -> Int
httpStatus :: Prelude.Int,
    -- | The name of the job queue.
    CreateJobQueueResponse -> Text
jobQueueName :: Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the job queue.
    CreateJobQueueResponse -> Text
jobQueueArn :: Prelude.Text
  }
  deriving (CreateJobQueueResponse -> CreateJobQueueResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateJobQueueResponse -> CreateJobQueueResponse -> Bool
$c/= :: CreateJobQueueResponse -> CreateJobQueueResponse -> Bool
== :: CreateJobQueueResponse -> CreateJobQueueResponse -> Bool
$c== :: CreateJobQueueResponse -> CreateJobQueueResponse -> Bool
Prelude.Eq, ReadPrec [CreateJobQueueResponse]
ReadPrec CreateJobQueueResponse
Int -> ReadS CreateJobQueueResponse
ReadS [CreateJobQueueResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateJobQueueResponse]
$creadListPrec :: ReadPrec [CreateJobQueueResponse]
readPrec :: ReadPrec CreateJobQueueResponse
$creadPrec :: ReadPrec CreateJobQueueResponse
readList :: ReadS [CreateJobQueueResponse]
$creadList :: ReadS [CreateJobQueueResponse]
readsPrec :: Int -> ReadS CreateJobQueueResponse
$creadsPrec :: Int -> ReadS CreateJobQueueResponse
Prelude.Read, Int -> CreateJobQueueResponse -> ShowS
[CreateJobQueueResponse] -> ShowS
CreateJobQueueResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateJobQueueResponse] -> ShowS
$cshowList :: [CreateJobQueueResponse] -> ShowS
show :: CreateJobQueueResponse -> String
$cshow :: CreateJobQueueResponse -> String
showsPrec :: Int -> CreateJobQueueResponse -> ShowS
$cshowsPrec :: Int -> CreateJobQueueResponse -> ShowS
Prelude.Show, forall x. Rep CreateJobQueueResponse x -> CreateJobQueueResponse
forall x. CreateJobQueueResponse -> Rep CreateJobQueueResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateJobQueueResponse x -> CreateJobQueueResponse
$cfrom :: forall x. CreateJobQueueResponse -> Rep CreateJobQueueResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateJobQueueResponse' 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:
--
-- 'httpStatus', 'createJobQueueResponse_httpStatus' - The response's http status code.
--
-- 'jobQueueName', 'createJobQueueResponse_jobQueueName' - The name of the job queue.
--
-- 'jobQueueArn', 'createJobQueueResponse_jobQueueArn' - The Amazon Resource Name (ARN) of the job queue.
newCreateJobQueueResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'jobQueueName'
  Prelude.Text ->
  -- | 'jobQueueArn'
  Prelude.Text ->
  CreateJobQueueResponse
newCreateJobQueueResponse :: Int -> Text -> Text -> CreateJobQueueResponse
newCreateJobQueueResponse
  Int
pHttpStatus_
  Text
pJobQueueName_
  Text
pJobQueueArn_ =
    CreateJobQueueResponse'
      { $sel:httpStatus:CreateJobQueueResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:jobQueueName:CreateJobQueueResponse' :: Text
jobQueueName = Text
pJobQueueName_,
        $sel:jobQueueArn:CreateJobQueueResponse' :: Text
jobQueueArn = Text
pJobQueueArn_
      }

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

-- | The name of the job queue.
createJobQueueResponse_jobQueueName :: Lens.Lens' CreateJobQueueResponse Prelude.Text
createJobQueueResponse_jobQueueName :: Lens' CreateJobQueueResponse Text
createJobQueueResponse_jobQueueName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJobQueueResponse' {Text
jobQueueName :: Text
$sel:jobQueueName:CreateJobQueueResponse' :: CreateJobQueueResponse -> Text
jobQueueName} -> Text
jobQueueName) (\s :: CreateJobQueueResponse
s@CreateJobQueueResponse' {} Text
a -> CreateJobQueueResponse
s {$sel:jobQueueName:CreateJobQueueResponse' :: Text
jobQueueName = Text
a} :: CreateJobQueueResponse)

-- | The Amazon Resource Name (ARN) of the job queue.
createJobQueueResponse_jobQueueArn :: Lens.Lens' CreateJobQueueResponse Prelude.Text
createJobQueueResponse_jobQueueArn :: Lens' CreateJobQueueResponse Text
createJobQueueResponse_jobQueueArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJobQueueResponse' {Text
jobQueueArn :: Text
$sel:jobQueueArn:CreateJobQueueResponse' :: CreateJobQueueResponse -> Text
jobQueueArn} -> Text
jobQueueArn) (\s :: CreateJobQueueResponse
s@CreateJobQueueResponse' {} Text
a -> CreateJobQueueResponse
s {$sel:jobQueueArn:CreateJobQueueResponse' :: Text
jobQueueArn = Text
a} :: CreateJobQueueResponse)

instance Prelude.NFData CreateJobQueueResponse where
  rnf :: CreateJobQueueResponse -> ()
rnf CreateJobQueueResponse' {Int
Text
jobQueueArn :: Text
jobQueueName :: Text
httpStatus :: Int
$sel:jobQueueArn:CreateJobQueueResponse' :: CreateJobQueueResponse -> Text
$sel:jobQueueName:CreateJobQueueResponse' :: CreateJobQueueResponse -> Text
$sel:httpStatus:CreateJobQueueResponse' :: CreateJobQueueResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
jobQueueName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
jobQueueArn