{-# 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.Omics.GetRunGroup
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets information about a workflow run group.
module Amazonka.Omics.GetRunGroup
  ( -- * Creating a Request
    GetRunGroup (..),
    newGetRunGroup,

    -- * Request Lenses
    getRunGroup_id,

    -- * Destructuring the Response
    GetRunGroupResponse (..),
    newGetRunGroupResponse,

    -- * Response Lenses
    getRunGroupResponse_arn,
    getRunGroupResponse_creationTime,
    getRunGroupResponse_id,
    getRunGroupResponse_maxCpus,
    getRunGroupResponse_maxDuration,
    getRunGroupResponse_maxRuns,
    getRunGroupResponse_name,
    getRunGroupResponse_tags,
    getRunGroupResponse_httpStatus,
  )
where

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

-- | /See:/ 'newGetRunGroup' smart constructor.
data GetRunGroup = GetRunGroup'
  { -- | The group\'s ID.
    GetRunGroup -> Text
id :: Prelude.Text
  }
  deriving (GetRunGroup -> GetRunGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetRunGroup -> GetRunGroup -> Bool
$c/= :: GetRunGroup -> GetRunGroup -> Bool
== :: GetRunGroup -> GetRunGroup -> Bool
$c== :: GetRunGroup -> GetRunGroup -> Bool
Prelude.Eq, ReadPrec [GetRunGroup]
ReadPrec GetRunGroup
Int -> ReadS GetRunGroup
ReadS [GetRunGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetRunGroup]
$creadListPrec :: ReadPrec [GetRunGroup]
readPrec :: ReadPrec GetRunGroup
$creadPrec :: ReadPrec GetRunGroup
readList :: ReadS [GetRunGroup]
$creadList :: ReadS [GetRunGroup]
readsPrec :: Int -> ReadS GetRunGroup
$creadsPrec :: Int -> ReadS GetRunGroup
Prelude.Read, Int -> GetRunGroup -> ShowS
[GetRunGroup] -> ShowS
GetRunGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetRunGroup] -> ShowS
$cshowList :: [GetRunGroup] -> ShowS
show :: GetRunGroup -> String
$cshow :: GetRunGroup -> String
showsPrec :: Int -> GetRunGroup -> ShowS
$cshowsPrec :: Int -> GetRunGroup -> ShowS
Prelude.Show, forall x. Rep GetRunGroup x -> GetRunGroup
forall x. GetRunGroup -> Rep GetRunGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetRunGroup x -> GetRunGroup
$cfrom :: forall x. GetRunGroup -> Rep GetRunGroup x
Prelude.Generic)

-- |
-- Create a value of 'GetRunGroup' 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:
--
-- 'id', 'getRunGroup_id' - The group\'s ID.
newGetRunGroup ::
  -- | 'id'
  Prelude.Text ->
  GetRunGroup
newGetRunGroup :: Text -> GetRunGroup
newGetRunGroup Text
pId_ = GetRunGroup' {$sel:id:GetRunGroup' :: Text
id = Text
pId_}

-- | The group\'s ID.
getRunGroup_id :: Lens.Lens' GetRunGroup Prelude.Text
getRunGroup_id :: Lens' GetRunGroup Text
getRunGroup_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRunGroup' {Text
id :: Text
$sel:id:GetRunGroup' :: GetRunGroup -> Text
id} -> Text
id) (\s :: GetRunGroup
s@GetRunGroup' {} Text
a -> GetRunGroup
s {$sel:id:GetRunGroup' :: Text
id = Text
a} :: GetRunGroup)

instance Core.AWSRequest GetRunGroup where
  type AWSResponse GetRunGroup = GetRunGroupResponse
  request :: (Service -> Service) -> GetRunGroup -> Request GetRunGroup
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetRunGroup
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetRunGroup)))
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 ISO8601
-> Maybe Text
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe Text
-> Maybe (HashMap Text Text)
-> Int
-> GetRunGroupResponse
GetRunGroupResponse'
            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
"arn")
            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
"creationTime")
            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
"id")
            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
"maxCpus")
            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
"maxDuration")
            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
"maxRuns")
            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
"name")
            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
"tags" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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 GetRunGroup where
  hashWithSalt :: Int -> GetRunGroup -> Int
hashWithSalt Int
_salt GetRunGroup' {Text
id :: Text
$sel:id:GetRunGroup' :: GetRunGroup -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
id

instance Prelude.NFData GetRunGroup where
  rnf :: GetRunGroup -> ()
rnf GetRunGroup' {Text
id :: Text
$sel:id:GetRunGroup' :: GetRunGroup -> Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Text
id

instance Data.ToHeaders GetRunGroup where
  toHeaders :: GetRunGroup -> 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.ToPath GetRunGroup where
  toPath :: GetRunGroup -> ByteString
toPath GetRunGroup' {Text
id :: Text
$sel:id:GetRunGroup' :: GetRunGroup -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"/runGroup/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
id]

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

-- | /See:/ 'newGetRunGroupResponse' smart constructor.
data GetRunGroupResponse = GetRunGroupResponse'
  { -- | The group\'s ARN.
    GetRunGroupResponse -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    -- | When the group was created.
    GetRunGroupResponse -> Maybe ISO8601
creationTime :: Prelude.Maybe Data.ISO8601,
    -- | The group\'s ID.
    GetRunGroupResponse -> Maybe Text
id :: Prelude.Maybe Prelude.Text,
    -- | The group\'s maximum number of CPUs to use.
    GetRunGroupResponse -> Maybe Natural
maxCpus :: Prelude.Maybe Prelude.Natural,
    -- | The group\'s maximum run duration.
    GetRunGroupResponse -> Maybe Natural
maxDuration :: Prelude.Maybe Prelude.Natural,
    -- | The maximum number of concurrent runs for the group.
    GetRunGroupResponse -> Maybe Natural
maxRuns :: Prelude.Maybe Prelude.Natural,
    -- | The group\'s name.
    GetRunGroupResponse -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The group\'s tags.
    GetRunGroupResponse -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The response's http status code.
    GetRunGroupResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetRunGroupResponse -> GetRunGroupResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetRunGroupResponse -> GetRunGroupResponse -> Bool
$c/= :: GetRunGroupResponse -> GetRunGroupResponse -> Bool
== :: GetRunGroupResponse -> GetRunGroupResponse -> Bool
$c== :: GetRunGroupResponse -> GetRunGroupResponse -> Bool
Prelude.Eq, ReadPrec [GetRunGroupResponse]
ReadPrec GetRunGroupResponse
Int -> ReadS GetRunGroupResponse
ReadS [GetRunGroupResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetRunGroupResponse]
$creadListPrec :: ReadPrec [GetRunGroupResponse]
readPrec :: ReadPrec GetRunGroupResponse
$creadPrec :: ReadPrec GetRunGroupResponse
readList :: ReadS [GetRunGroupResponse]
$creadList :: ReadS [GetRunGroupResponse]
readsPrec :: Int -> ReadS GetRunGroupResponse
$creadsPrec :: Int -> ReadS GetRunGroupResponse
Prelude.Read, Int -> GetRunGroupResponse -> ShowS
[GetRunGroupResponse] -> ShowS
GetRunGroupResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetRunGroupResponse] -> ShowS
$cshowList :: [GetRunGroupResponse] -> ShowS
show :: GetRunGroupResponse -> String
$cshow :: GetRunGroupResponse -> String
showsPrec :: Int -> GetRunGroupResponse -> ShowS
$cshowsPrec :: Int -> GetRunGroupResponse -> ShowS
Prelude.Show, forall x. Rep GetRunGroupResponse x -> GetRunGroupResponse
forall x. GetRunGroupResponse -> Rep GetRunGroupResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetRunGroupResponse x -> GetRunGroupResponse
$cfrom :: forall x. GetRunGroupResponse -> Rep GetRunGroupResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetRunGroupResponse' 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:
--
-- 'arn', 'getRunGroupResponse_arn' - The group\'s ARN.
--
-- 'creationTime', 'getRunGroupResponse_creationTime' - When the group was created.
--
-- 'id', 'getRunGroupResponse_id' - The group\'s ID.
--
-- 'maxCpus', 'getRunGroupResponse_maxCpus' - The group\'s maximum number of CPUs to use.
--
-- 'maxDuration', 'getRunGroupResponse_maxDuration' - The group\'s maximum run duration.
--
-- 'maxRuns', 'getRunGroupResponse_maxRuns' - The maximum number of concurrent runs for the group.
--
-- 'name', 'getRunGroupResponse_name' - The group\'s name.
--
-- 'tags', 'getRunGroupResponse_tags' - The group\'s tags.
--
-- 'httpStatus', 'getRunGroupResponse_httpStatus' - The response's http status code.
newGetRunGroupResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetRunGroupResponse
newGetRunGroupResponse :: Int -> GetRunGroupResponse
newGetRunGroupResponse Int
pHttpStatus_ =
  GetRunGroupResponse'
    { $sel:arn:GetRunGroupResponse' :: Maybe Text
arn = forall a. Maybe a
Prelude.Nothing,
      $sel:creationTime:GetRunGroupResponse' :: Maybe ISO8601
creationTime = forall a. Maybe a
Prelude.Nothing,
      $sel:id:GetRunGroupResponse' :: Maybe Text
id = forall a. Maybe a
Prelude.Nothing,
      $sel:maxCpus:GetRunGroupResponse' :: Maybe Natural
maxCpus = forall a. Maybe a
Prelude.Nothing,
      $sel:maxDuration:GetRunGroupResponse' :: Maybe Natural
maxDuration = forall a. Maybe a
Prelude.Nothing,
      $sel:maxRuns:GetRunGroupResponse' :: Maybe Natural
maxRuns = forall a. Maybe a
Prelude.Nothing,
      $sel:name:GetRunGroupResponse' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:GetRunGroupResponse' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetRunGroupResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The group\'s ARN.
getRunGroupResponse_arn :: Lens.Lens' GetRunGroupResponse (Prelude.Maybe Prelude.Text)
getRunGroupResponse_arn :: Lens' GetRunGroupResponse (Maybe Text)
getRunGroupResponse_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRunGroupResponse' {Maybe Text
arn :: Maybe Text
$sel:arn:GetRunGroupResponse' :: GetRunGroupResponse -> Maybe Text
arn} -> Maybe Text
arn) (\s :: GetRunGroupResponse
s@GetRunGroupResponse' {} Maybe Text
a -> GetRunGroupResponse
s {$sel:arn:GetRunGroupResponse' :: Maybe Text
arn = Maybe Text
a} :: GetRunGroupResponse)

-- | When the group was created.
getRunGroupResponse_creationTime :: Lens.Lens' GetRunGroupResponse (Prelude.Maybe Prelude.UTCTime)
getRunGroupResponse_creationTime :: Lens' GetRunGroupResponse (Maybe UTCTime)
getRunGroupResponse_creationTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRunGroupResponse' {Maybe ISO8601
creationTime :: Maybe ISO8601
$sel:creationTime:GetRunGroupResponse' :: GetRunGroupResponse -> Maybe ISO8601
creationTime} -> Maybe ISO8601
creationTime) (\s :: GetRunGroupResponse
s@GetRunGroupResponse' {} Maybe ISO8601
a -> GetRunGroupResponse
s {$sel:creationTime:GetRunGroupResponse' :: Maybe ISO8601
creationTime = Maybe ISO8601
a} :: GetRunGroupResponse) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The group\'s ID.
getRunGroupResponse_id :: Lens.Lens' GetRunGroupResponse (Prelude.Maybe Prelude.Text)
getRunGroupResponse_id :: Lens' GetRunGroupResponse (Maybe Text)
getRunGroupResponse_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRunGroupResponse' {Maybe Text
id :: Maybe Text
$sel:id:GetRunGroupResponse' :: GetRunGroupResponse -> Maybe Text
id} -> Maybe Text
id) (\s :: GetRunGroupResponse
s@GetRunGroupResponse' {} Maybe Text
a -> GetRunGroupResponse
s {$sel:id:GetRunGroupResponse' :: Maybe Text
id = Maybe Text
a} :: GetRunGroupResponse)

-- | The group\'s maximum number of CPUs to use.
getRunGroupResponse_maxCpus :: Lens.Lens' GetRunGroupResponse (Prelude.Maybe Prelude.Natural)
getRunGroupResponse_maxCpus :: Lens' GetRunGroupResponse (Maybe Natural)
getRunGroupResponse_maxCpus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRunGroupResponse' {Maybe Natural
maxCpus :: Maybe Natural
$sel:maxCpus:GetRunGroupResponse' :: GetRunGroupResponse -> Maybe Natural
maxCpus} -> Maybe Natural
maxCpus) (\s :: GetRunGroupResponse
s@GetRunGroupResponse' {} Maybe Natural
a -> GetRunGroupResponse
s {$sel:maxCpus:GetRunGroupResponse' :: Maybe Natural
maxCpus = Maybe Natural
a} :: GetRunGroupResponse)

-- | The group\'s maximum run duration.
getRunGroupResponse_maxDuration :: Lens.Lens' GetRunGroupResponse (Prelude.Maybe Prelude.Natural)
getRunGroupResponse_maxDuration :: Lens' GetRunGroupResponse (Maybe Natural)
getRunGroupResponse_maxDuration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRunGroupResponse' {Maybe Natural
maxDuration :: Maybe Natural
$sel:maxDuration:GetRunGroupResponse' :: GetRunGroupResponse -> Maybe Natural
maxDuration} -> Maybe Natural
maxDuration) (\s :: GetRunGroupResponse
s@GetRunGroupResponse' {} Maybe Natural
a -> GetRunGroupResponse
s {$sel:maxDuration:GetRunGroupResponse' :: Maybe Natural
maxDuration = Maybe Natural
a} :: GetRunGroupResponse)

-- | The maximum number of concurrent runs for the group.
getRunGroupResponse_maxRuns :: Lens.Lens' GetRunGroupResponse (Prelude.Maybe Prelude.Natural)
getRunGroupResponse_maxRuns :: Lens' GetRunGroupResponse (Maybe Natural)
getRunGroupResponse_maxRuns = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRunGroupResponse' {Maybe Natural
maxRuns :: Maybe Natural
$sel:maxRuns:GetRunGroupResponse' :: GetRunGroupResponse -> Maybe Natural
maxRuns} -> Maybe Natural
maxRuns) (\s :: GetRunGroupResponse
s@GetRunGroupResponse' {} Maybe Natural
a -> GetRunGroupResponse
s {$sel:maxRuns:GetRunGroupResponse' :: Maybe Natural
maxRuns = Maybe Natural
a} :: GetRunGroupResponse)

-- | The group\'s name.
getRunGroupResponse_name :: Lens.Lens' GetRunGroupResponse (Prelude.Maybe Prelude.Text)
getRunGroupResponse_name :: Lens' GetRunGroupResponse (Maybe Text)
getRunGroupResponse_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRunGroupResponse' {Maybe Text
name :: Maybe Text
$sel:name:GetRunGroupResponse' :: GetRunGroupResponse -> Maybe Text
name} -> Maybe Text
name) (\s :: GetRunGroupResponse
s@GetRunGroupResponse' {} Maybe Text
a -> GetRunGroupResponse
s {$sel:name:GetRunGroupResponse' :: Maybe Text
name = Maybe Text
a} :: GetRunGroupResponse)

-- | The group\'s tags.
getRunGroupResponse_tags :: Lens.Lens' GetRunGroupResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
getRunGroupResponse_tags :: Lens' GetRunGroupResponse (Maybe (HashMap Text Text))
getRunGroupResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRunGroupResponse' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:GetRunGroupResponse' :: GetRunGroupResponse -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: GetRunGroupResponse
s@GetRunGroupResponse' {} Maybe (HashMap Text Text)
a -> GetRunGroupResponse
s {$sel:tags:GetRunGroupResponse' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: GetRunGroupResponse) 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 response's http status code.
getRunGroupResponse_httpStatus :: Lens.Lens' GetRunGroupResponse Prelude.Int
getRunGroupResponse_httpStatus :: Lens' GetRunGroupResponse Int
getRunGroupResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRunGroupResponse' {Int
httpStatus :: Int
$sel:httpStatus:GetRunGroupResponse' :: GetRunGroupResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: GetRunGroupResponse
s@GetRunGroupResponse' {} Int
a -> GetRunGroupResponse
s {$sel:httpStatus:GetRunGroupResponse' :: Int
httpStatus = Int
a} :: GetRunGroupResponse)

instance Prelude.NFData GetRunGroupResponse where
  rnf :: GetRunGroupResponse -> ()
rnf GetRunGroupResponse' {Int
Maybe Natural
Maybe Text
Maybe (HashMap Text Text)
Maybe ISO8601
httpStatus :: Int
tags :: Maybe (HashMap Text Text)
name :: Maybe Text
maxRuns :: Maybe Natural
maxDuration :: Maybe Natural
maxCpus :: Maybe Natural
id :: Maybe Text
creationTime :: Maybe ISO8601
arn :: Maybe Text
$sel:httpStatus:GetRunGroupResponse' :: GetRunGroupResponse -> Int
$sel:tags:GetRunGroupResponse' :: GetRunGroupResponse -> Maybe (HashMap Text Text)
$sel:name:GetRunGroupResponse' :: GetRunGroupResponse -> Maybe Text
$sel:maxRuns:GetRunGroupResponse' :: GetRunGroupResponse -> Maybe Natural
$sel:maxDuration:GetRunGroupResponse' :: GetRunGroupResponse -> Maybe Natural
$sel:maxCpus:GetRunGroupResponse' :: GetRunGroupResponse -> Maybe Natural
$sel:id:GetRunGroupResponse' :: GetRunGroupResponse -> Maybe Text
$sel:creationTime:GetRunGroupResponse' :: GetRunGroupResponse -> Maybe ISO8601
$sel:arn:GetRunGroupResponse' :: GetRunGroupResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
arn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
creationTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
id
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
maxCpus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
maxDuration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
maxRuns
      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 (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus