{-# 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.GetConfig
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns @Config@ information.
--
-- Only one @Config@ response can be returned.
module Amazonka.GroundStation.GetConfig
  ( -- * Creating a Request
    GetConfig (..),
    newGetConfig,

    -- * Request Lenses
    getConfig_configId,
    getConfig_configType,

    -- * Destructuring the Response
    GetConfigResponse (..),
    newGetConfigResponse,

    -- * Response Lenses
    getConfigResponse_configType,
    getConfigResponse_tags,
    getConfigResponse_httpStatus,
    getConfigResponse_configArn,
    getConfigResponse_configData,
    getConfigResponse_configId,
    getConfigResponse_name,
  )
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:/ 'newGetConfig' smart constructor.
data GetConfig = GetConfig'
  { -- | UUID of a @Config@.
    GetConfig -> Text
configId :: Prelude.Text,
    -- | Type of a @Config@.
    GetConfig -> ConfigCapabilityType
configType :: ConfigCapabilityType
  }
  deriving (GetConfig -> GetConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetConfig -> GetConfig -> Bool
$c/= :: GetConfig -> GetConfig -> Bool
== :: GetConfig -> GetConfig -> Bool
$c== :: GetConfig -> GetConfig -> Bool
Prelude.Eq, ReadPrec [GetConfig]
ReadPrec GetConfig
Int -> ReadS GetConfig
ReadS [GetConfig]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetConfig]
$creadListPrec :: ReadPrec [GetConfig]
readPrec :: ReadPrec GetConfig
$creadPrec :: ReadPrec GetConfig
readList :: ReadS [GetConfig]
$creadList :: ReadS [GetConfig]
readsPrec :: Int -> ReadS GetConfig
$creadsPrec :: Int -> ReadS GetConfig
Prelude.Read, Int -> GetConfig -> ShowS
[GetConfig] -> ShowS
GetConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetConfig] -> ShowS
$cshowList :: [GetConfig] -> ShowS
show :: GetConfig -> String
$cshow :: GetConfig -> String
showsPrec :: Int -> GetConfig -> ShowS
$cshowsPrec :: Int -> GetConfig -> ShowS
Prelude.Show, forall x. Rep GetConfig x -> GetConfig
forall x. GetConfig -> Rep GetConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetConfig x -> GetConfig
$cfrom :: forall x. GetConfig -> Rep GetConfig x
Prelude.Generic)

-- |
-- Create a value of 'GetConfig' 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:
--
-- 'configId', 'getConfig_configId' - UUID of a @Config@.
--
-- 'configType', 'getConfig_configType' - Type of a @Config@.
newGetConfig ::
  -- | 'configId'
  Prelude.Text ->
  -- | 'configType'
  ConfigCapabilityType ->
  GetConfig
newGetConfig :: Text -> ConfigCapabilityType -> GetConfig
newGetConfig Text
pConfigId_ ConfigCapabilityType
pConfigType_ =
  GetConfig'
    { $sel:configId:GetConfig' :: Text
configId = Text
pConfigId_,
      $sel:configType:GetConfig' :: ConfigCapabilityType
configType = ConfigCapabilityType
pConfigType_
    }

-- | UUID of a @Config@.
getConfig_configId :: Lens.Lens' GetConfig Prelude.Text
getConfig_configId :: Lens' GetConfig Text
getConfig_configId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetConfig' {Text
configId :: Text
$sel:configId:GetConfig' :: GetConfig -> Text
configId} -> Text
configId) (\s :: GetConfig
s@GetConfig' {} Text
a -> GetConfig
s {$sel:configId:GetConfig' :: Text
configId = Text
a} :: GetConfig)

-- | Type of a @Config@.
getConfig_configType :: Lens.Lens' GetConfig ConfigCapabilityType
getConfig_configType :: Lens' GetConfig ConfigCapabilityType
getConfig_configType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetConfig' {ConfigCapabilityType
configType :: ConfigCapabilityType
$sel:configType:GetConfig' :: GetConfig -> ConfigCapabilityType
configType} -> ConfigCapabilityType
configType) (\s :: GetConfig
s@GetConfig' {} ConfigCapabilityType
a -> GetConfig
s {$sel:configType:GetConfig' :: ConfigCapabilityType
configType = ConfigCapabilityType
a} :: GetConfig)

instance Core.AWSRequest GetConfig where
  type AWSResponse GetConfig = GetConfigResponse
  request :: (Service -> Service) -> GetConfig -> Request GetConfig
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 GetConfig
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetConfig)))
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 ConfigCapabilityType
-> Maybe (HashMap Text Text)
-> Int
-> Text
-> ConfigTypeData
-> Text
-> Text
-> GetConfigResponse
GetConfigResponse'
            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
"configType")
            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))
            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
"configArn")
            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
"configData")
            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
"configId")
            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
"name")
      )

instance Prelude.Hashable GetConfig where
  hashWithSalt :: Int -> GetConfig -> Int
hashWithSalt Int
_salt GetConfig' {Text
ConfigCapabilityType
configType :: ConfigCapabilityType
configId :: Text
$sel:configType:GetConfig' :: GetConfig -> ConfigCapabilityType
$sel:configId:GetConfig' :: GetConfig -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
configId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ConfigCapabilityType
configType

instance Prelude.NFData GetConfig where
  rnf :: GetConfig -> ()
rnf GetConfig' {Text
ConfigCapabilityType
configType :: ConfigCapabilityType
configId :: Text
$sel:configType:GetConfig' :: GetConfig -> ConfigCapabilityType
$sel:configId:GetConfig' :: GetConfig -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
configId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ConfigCapabilityType
configType

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

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

-- |
--
-- /See:/ 'newGetConfigResponse' smart constructor.
data GetConfigResponse = GetConfigResponse'
  { -- | Type of a @Config@.
    GetConfigResponse -> Maybe ConfigCapabilityType
configType :: Prelude.Maybe ConfigCapabilityType,
    -- | Tags assigned to a @Config@.
    GetConfigResponse -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The response's http status code.
    GetConfigResponse -> Int
httpStatus :: Prelude.Int,
    -- | ARN of a @Config@
    GetConfigResponse -> Text
configArn :: Prelude.Text,
    -- | Data elements in a @Config@.
    GetConfigResponse -> ConfigTypeData
configData :: ConfigTypeData,
    -- | UUID of a @Config@.
    GetConfigResponse -> Text
configId :: Prelude.Text,
    -- | Name of a @Config@.
    GetConfigResponse -> Text
name :: Prelude.Text
  }
  deriving (GetConfigResponse -> GetConfigResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetConfigResponse -> GetConfigResponse -> Bool
$c/= :: GetConfigResponse -> GetConfigResponse -> Bool
== :: GetConfigResponse -> GetConfigResponse -> Bool
$c== :: GetConfigResponse -> GetConfigResponse -> Bool
Prelude.Eq, ReadPrec [GetConfigResponse]
ReadPrec GetConfigResponse
Int -> ReadS GetConfigResponse
ReadS [GetConfigResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetConfigResponse]
$creadListPrec :: ReadPrec [GetConfigResponse]
readPrec :: ReadPrec GetConfigResponse
$creadPrec :: ReadPrec GetConfigResponse
readList :: ReadS [GetConfigResponse]
$creadList :: ReadS [GetConfigResponse]
readsPrec :: Int -> ReadS GetConfigResponse
$creadsPrec :: Int -> ReadS GetConfigResponse
Prelude.Read, Int -> GetConfigResponse -> ShowS
[GetConfigResponse] -> ShowS
GetConfigResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetConfigResponse] -> ShowS
$cshowList :: [GetConfigResponse] -> ShowS
show :: GetConfigResponse -> String
$cshow :: GetConfigResponse -> String
showsPrec :: Int -> GetConfigResponse -> ShowS
$cshowsPrec :: Int -> GetConfigResponse -> ShowS
Prelude.Show, forall x. Rep GetConfigResponse x -> GetConfigResponse
forall x. GetConfigResponse -> Rep GetConfigResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetConfigResponse x -> GetConfigResponse
$cfrom :: forall x. GetConfigResponse -> Rep GetConfigResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetConfigResponse' 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:
--
-- 'configType', 'getConfigResponse_configType' - Type of a @Config@.
--
-- 'tags', 'getConfigResponse_tags' - Tags assigned to a @Config@.
--
-- 'httpStatus', 'getConfigResponse_httpStatus' - The response's http status code.
--
-- 'configArn', 'getConfigResponse_configArn' - ARN of a @Config@
--
-- 'configData', 'getConfigResponse_configData' - Data elements in a @Config@.
--
-- 'configId', 'getConfigResponse_configId' - UUID of a @Config@.
--
-- 'name', 'getConfigResponse_name' - Name of a @Config@.
newGetConfigResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'configArn'
  Prelude.Text ->
  -- | 'configData'
  ConfigTypeData ->
  -- | 'configId'
  Prelude.Text ->
  -- | 'name'
  Prelude.Text ->
  GetConfigResponse
newGetConfigResponse :: Int -> Text -> ConfigTypeData -> Text -> Text -> GetConfigResponse
newGetConfigResponse
  Int
pHttpStatus_
  Text
pConfigArn_
  ConfigTypeData
pConfigData_
  Text
pConfigId_
  Text
pName_ =
    GetConfigResponse'
      { $sel:configType:GetConfigResponse' :: Maybe ConfigCapabilityType
configType = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:GetConfigResponse' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:GetConfigResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:configArn:GetConfigResponse' :: Text
configArn = Text
pConfigArn_,
        $sel:configData:GetConfigResponse' :: ConfigTypeData
configData = ConfigTypeData
pConfigData_,
        $sel:configId:GetConfigResponse' :: Text
configId = Text
pConfigId_,
        $sel:name:GetConfigResponse' :: Text
name = Text
pName_
      }

-- | Type of a @Config@.
getConfigResponse_configType :: Lens.Lens' GetConfigResponse (Prelude.Maybe ConfigCapabilityType)
getConfigResponse_configType :: Lens' GetConfigResponse (Maybe ConfigCapabilityType)
getConfigResponse_configType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetConfigResponse' {Maybe ConfigCapabilityType
configType :: Maybe ConfigCapabilityType
$sel:configType:GetConfigResponse' :: GetConfigResponse -> Maybe ConfigCapabilityType
configType} -> Maybe ConfigCapabilityType
configType) (\s :: GetConfigResponse
s@GetConfigResponse' {} Maybe ConfigCapabilityType
a -> GetConfigResponse
s {$sel:configType:GetConfigResponse' :: Maybe ConfigCapabilityType
configType = Maybe ConfigCapabilityType
a} :: GetConfigResponse)

-- | Tags assigned to a @Config@.
getConfigResponse_tags :: Lens.Lens' GetConfigResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
getConfigResponse_tags :: Lens' GetConfigResponse (Maybe (HashMap Text Text))
getConfigResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetConfigResponse' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:GetConfigResponse' :: GetConfigResponse -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: GetConfigResponse
s@GetConfigResponse' {} Maybe (HashMap Text Text)
a -> GetConfigResponse
s {$sel:tags:GetConfigResponse' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: GetConfigResponse) 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.
getConfigResponse_httpStatus :: Lens.Lens' GetConfigResponse Prelude.Int
getConfigResponse_httpStatus :: Lens' GetConfigResponse Int
getConfigResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetConfigResponse' {Int
httpStatus :: Int
$sel:httpStatus:GetConfigResponse' :: GetConfigResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: GetConfigResponse
s@GetConfigResponse' {} Int
a -> GetConfigResponse
s {$sel:httpStatus:GetConfigResponse' :: Int
httpStatus = Int
a} :: GetConfigResponse)

-- | ARN of a @Config@
getConfigResponse_configArn :: Lens.Lens' GetConfigResponse Prelude.Text
getConfigResponse_configArn :: Lens' GetConfigResponse Text
getConfigResponse_configArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetConfigResponse' {Text
configArn :: Text
$sel:configArn:GetConfigResponse' :: GetConfigResponse -> Text
configArn} -> Text
configArn) (\s :: GetConfigResponse
s@GetConfigResponse' {} Text
a -> GetConfigResponse
s {$sel:configArn:GetConfigResponse' :: Text
configArn = Text
a} :: GetConfigResponse)

-- | Data elements in a @Config@.
getConfigResponse_configData :: Lens.Lens' GetConfigResponse ConfigTypeData
getConfigResponse_configData :: Lens' GetConfigResponse ConfigTypeData
getConfigResponse_configData = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetConfigResponse' {ConfigTypeData
configData :: ConfigTypeData
$sel:configData:GetConfigResponse' :: GetConfigResponse -> ConfigTypeData
configData} -> ConfigTypeData
configData) (\s :: GetConfigResponse
s@GetConfigResponse' {} ConfigTypeData
a -> GetConfigResponse
s {$sel:configData:GetConfigResponse' :: ConfigTypeData
configData = ConfigTypeData
a} :: GetConfigResponse)

-- | UUID of a @Config@.
getConfigResponse_configId :: Lens.Lens' GetConfigResponse Prelude.Text
getConfigResponse_configId :: Lens' GetConfigResponse Text
getConfigResponse_configId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetConfigResponse' {Text
configId :: Text
$sel:configId:GetConfigResponse' :: GetConfigResponse -> Text
configId} -> Text
configId) (\s :: GetConfigResponse
s@GetConfigResponse' {} Text
a -> GetConfigResponse
s {$sel:configId:GetConfigResponse' :: Text
configId = Text
a} :: GetConfigResponse)

-- | Name of a @Config@.
getConfigResponse_name :: Lens.Lens' GetConfigResponse Prelude.Text
getConfigResponse_name :: Lens' GetConfigResponse Text
getConfigResponse_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetConfigResponse' {Text
name :: Text
$sel:name:GetConfigResponse' :: GetConfigResponse -> Text
name} -> Text
name) (\s :: GetConfigResponse
s@GetConfigResponse' {} Text
a -> GetConfigResponse
s {$sel:name:GetConfigResponse' :: Text
name = Text
a} :: GetConfigResponse)

instance Prelude.NFData GetConfigResponse where
  rnf :: GetConfigResponse -> ()
rnf GetConfigResponse' {Int
Maybe (HashMap Text Text)
Maybe ConfigCapabilityType
Text
ConfigTypeData
name :: Text
configId :: Text
configData :: ConfigTypeData
configArn :: Text
httpStatus :: Int
tags :: Maybe (HashMap Text Text)
configType :: Maybe ConfigCapabilityType
$sel:name:GetConfigResponse' :: GetConfigResponse -> Text
$sel:configId:GetConfigResponse' :: GetConfigResponse -> Text
$sel:configData:GetConfigResponse' :: GetConfigResponse -> ConfigTypeData
$sel:configArn:GetConfigResponse' :: GetConfigResponse -> Text
$sel:httpStatus:GetConfigResponse' :: GetConfigResponse -> Int
$sel:tags:GetConfigResponse' :: GetConfigResponse -> Maybe (HashMap Text Text)
$sel:configType:GetConfigResponse' :: GetConfigResponse -> Maybe ConfigCapabilityType
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ConfigCapabilityType
configType
      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
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
configArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ConfigTypeData
configData
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
configId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name