{-# 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.CreateConfig
-- 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 a @Config@ with the specified @configData@ parameters.
--
-- Only one type of @configData@ can be specified.
module Amazonka.GroundStation.CreateConfig
  ( -- * Creating a Request
    CreateConfig (..),
    newCreateConfig,

    -- * Request Lenses
    createConfig_tags,
    createConfig_configData,
    createConfig_name,

    -- * Destructuring the Response
    ConfigIdResponse (..),
    newConfigIdResponse,

    -- * Response Lenses
    configIdResponse_configArn,
    configIdResponse_configId,
    configIdResponse_configType,
  )
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:/ 'newCreateConfig' smart constructor.
data CreateConfig = CreateConfig'
  { -- | Tags assigned to a @Config@.
    CreateConfig -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | Parameters of a @Config@.
    CreateConfig -> ConfigTypeData
configData :: ConfigTypeData,
    -- | Name of a @Config@.
    CreateConfig -> Text
name :: Prelude.Text
  }
  deriving (CreateConfig -> CreateConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateConfig -> CreateConfig -> Bool
$c/= :: CreateConfig -> CreateConfig -> Bool
== :: CreateConfig -> CreateConfig -> Bool
$c== :: CreateConfig -> CreateConfig -> Bool
Prelude.Eq, ReadPrec [CreateConfig]
ReadPrec CreateConfig
Int -> ReadS CreateConfig
ReadS [CreateConfig]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateConfig]
$creadListPrec :: ReadPrec [CreateConfig]
readPrec :: ReadPrec CreateConfig
$creadPrec :: ReadPrec CreateConfig
readList :: ReadS [CreateConfig]
$creadList :: ReadS [CreateConfig]
readsPrec :: Int -> ReadS CreateConfig
$creadsPrec :: Int -> ReadS CreateConfig
Prelude.Read, Int -> CreateConfig -> ShowS
[CreateConfig] -> ShowS
CreateConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateConfig] -> ShowS
$cshowList :: [CreateConfig] -> ShowS
show :: CreateConfig -> String
$cshow :: CreateConfig -> String
showsPrec :: Int -> CreateConfig -> ShowS
$cshowsPrec :: Int -> CreateConfig -> ShowS
Prelude.Show, forall x. Rep CreateConfig x -> CreateConfig
forall x. CreateConfig -> Rep CreateConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateConfig x -> CreateConfig
$cfrom :: forall x. CreateConfig -> Rep CreateConfig x
Prelude.Generic)

-- |
-- Create a value of 'CreateConfig' 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:
--
-- 'tags', 'createConfig_tags' - Tags assigned to a @Config@.
--
-- 'configData', 'createConfig_configData' - Parameters of a @Config@.
--
-- 'name', 'createConfig_name' - Name of a @Config@.
newCreateConfig ::
  -- | 'configData'
  ConfigTypeData ->
  -- | 'name'
  Prelude.Text ->
  CreateConfig
newCreateConfig :: ConfigTypeData -> Text -> CreateConfig
newCreateConfig ConfigTypeData
pConfigData_ Text
pName_ =
  CreateConfig'
    { $sel:tags:CreateConfig' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:configData:CreateConfig' :: ConfigTypeData
configData = ConfigTypeData
pConfigData_,
      $sel:name:CreateConfig' :: Text
name = Text
pName_
    }

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

-- | Parameters of a @Config@.
createConfig_configData :: Lens.Lens' CreateConfig ConfigTypeData
createConfig_configData :: Lens' CreateConfig ConfigTypeData
createConfig_configData = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateConfig' {ConfigTypeData
configData :: ConfigTypeData
$sel:configData:CreateConfig' :: CreateConfig -> ConfigTypeData
configData} -> ConfigTypeData
configData) (\s :: CreateConfig
s@CreateConfig' {} ConfigTypeData
a -> CreateConfig
s {$sel:configData:CreateConfig' :: ConfigTypeData
configData = ConfigTypeData
a} :: CreateConfig)

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

instance Core.AWSRequest CreateConfig where
  type AWSResponse CreateConfig = ConfigIdResponse
  request :: (Service -> Service) -> CreateConfig -> Request CreateConfig
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 CreateConfig
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateConfig)))
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 -> forall a. FromJSON a => Object -> Either String a
Data.eitherParseJSON Object
x)

instance Prelude.Hashable CreateConfig where
  hashWithSalt :: Int -> CreateConfig -> Int
hashWithSalt Int
_salt CreateConfig' {Maybe (HashMap Text Text)
Text
ConfigTypeData
name :: Text
configData :: ConfigTypeData
tags :: Maybe (HashMap Text Text)
$sel:name:CreateConfig' :: CreateConfig -> Text
$sel:configData:CreateConfig' :: CreateConfig -> ConfigTypeData
$sel:tags:CreateConfig' :: CreateConfig -> Maybe (HashMap Text Text)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ConfigTypeData
configData
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

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

instance Data.ToHeaders CreateConfig where
  toHeaders :: CreateConfig -> 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 CreateConfig where
  toJSON :: CreateConfig -> Value
toJSON CreateConfig' {Maybe (HashMap Text Text)
Text
ConfigTypeData
name :: Text
configData :: ConfigTypeData
tags :: Maybe (HashMap Text Text)
$sel:name:CreateConfig' :: CreateConfig -> Text
$sel:configData:CreateConfig' :: CreateConfig -> ConfigTypeData
$sel:tags:CreateConfig' :: CreateConfig -> Maybe (HashMap Text Text)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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
"configData" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ConfigTypeData
configData),
            forall a. a -> Maybe a
Prelude.Just (Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name)
          ]
      )

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

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