{-# 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.AlexaBusiness.CreateGatewayGroup
-- 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 gateway group with the specified details.
module Amazonka.AlexaBusiness.CreateGatewayGroup
  ( -- * Creating a Request
    CreateGatewayGroup (..),
    newCreateGatewayGroup,

    -- * Request Lenses
    createGatewayGroup_description,
    createGatewayGroup_tags,
    createGatewayGroup_name,
    createGatewayGroup_clientRequestToken,

    -- * Destructuring the Response
    CreateGatewayGroupResponse (..),
    newCreateGatewayGroupResponse,

    -- * Response Lenses
    createGatewayGroupResponse_gatewayGroupArn,
    createGatewayGroupResponse_httpStatus,
  )
where

import Amazonka.AlexaBusiness.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

-- | /See:/ 'newCreateGatewayGroup' smart constructor.
data CreateGatewayGroup = CreateGatewayGroup'
  { -- | The description of the gateway group.
    CreateGatewayGroup -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The tags to be added to the specified resource. Do not provide system
    -- tags.
    CreateGatewayGroup -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The name of the gateway group.
    CreateGatewayGroup -> Text
name :: Prelude.Text,
    -- | A unique, user-specified identifier for the request that ensures
    -- idempotency.
    CreateGatewayGroup -> Text
clientRequestToken :: Prelude.Text
  }
  deriving (CreateGatewayGroup -> CreateGatewayGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateGatewayGroup -> CreateGatewayGroup -> Bool
$c/= :: CreateGatewayGroup -> CreateGatewayGroup -> Bool
== :: CreateGatewayGroup -> CreateGatewayGroup -> Bool
$c== :: CreateGatewayGroup -> CreateGatewayGroup -> Bool
Prelude.Eq, ReadPrec [CreateGatewayGroup]
ReadPrec CreateGatewayGroup
Int -> ReadS CreateGatewayGroup
ReadS [CreateGatewayGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateGatewayGroup]
$creadListPrec :: ReadPrec [CreateGatewayGroup]
readPrec :: ReadPrec CreateGatewayGroup
$creadPrec :: ReadPrec CreateGatewayGroup
readList :: ReadS [CreateGatewayGroup]
$creadList :: ReadS [CreateGatewayGroup]
readsPrec :: Int -> ReadS CreateGatewayGroup
$creadsPrec :: Int -> ReadS CreateGatewayGroup
Prelude.Read, Int -> CreateGatewayGroup -> ShowS
[CreateGatewayGroup] -> ShowS
CreateGatewayGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateGatewayGroup] -> ShowS
$cshowList :: [CreateGatewayGroup] -> ShowS
show :: CreateGatewayGroup -> String
$cshow :: CreateGatewayGroup -> String
showsPrec :: Int -> CreateGatewayGroup -> ShowS
$cshowsPrec :: Int -> CreateGatewayGroup -> ShowS
Prelude.Show, forall x. Rep CreateGatewayGroup x -> CreateGatewayGroup
forall x. CreateGatewayGroup -> Rep CreateGatewayGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateGatewayGroup x -> CreateGatewayGroup
$cfrom :: forall x. CreateGatewayGroup -> Rep CreateGatewayGroup x
Prelude.Generic)

-- |
-- Create a value of 'CreateGatewayGroup' 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:
--
-- 'description', 'createGatewayGroup_description' - The description of the gateway group.
--
-- 'tags', 'createGatewayGroup_tags' - The tags to be added to the specified resource. Do not provide system
-- tags.
--
-- 'name', 'createGatewayGroup_name' - The name of the gateway group.
--
-- 'clientRequestToken', 'createGatewayGroup_clientRequestToken' - A unique, user-specified identifier for the request that ensures
-- idempotency.
newCreateGatewayGroup ::
  -- | 'name'
  Prelude.Text ->
  -- | 'clientRequestToken'
  Prelude.Text ->
  CreateGatewayGroup
newCreateGatewayGroup :: Text -> Text -> CreateGatewayGroup
newCreateGatewayGroup Text
pName_ Text
pClientRequestToken_ =
  CreateGatewayGroup'
    { $sel:description:CreateGatewayGroup' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateGatewayGroup' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:name:CreateGatewayGroup' :: Text
name = Text
pName_,
      $sel:clientRequestToken:CreateGatewayGroup' :: Text
clientRequestToken = Text
pClientRequestToken_
    }

-- | The description of the gateway group.
createGatewayGroup_description :: Lens.Lens' CreateGatewayGroup (Prelude.Maybe Prelude.Text)
createGatewayGroup_description :: Lens' CreateGatewayGroup (Maybe Text)
createGatewayGroup_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateGatewayGroup' {Maybe Text
description :: Maybe Text
$sel:description:CreateGatewayGroup' :: CreateGatewayGroup -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateGatewayGroup
s@CreateGatewayGroup' {} Maybe Text
a -> CreateGatewayGroup
s {$sel:description:CreateGatewayGroup' :: Maybe Text
description = Maybe Text
a} :: CreateGatewayGroup)

-- | The tags to be added to the specified resource. Do not provide system
-- tags.
createGatewayGroup_tags :: Lens.Lens' CreateGatewayGroup (Prelude.Maybe [Tag])
createGatewayGroup_tags :: Lens' CreateGatewayGroup (Maybe [Tag])
createGatewayGroup_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateGatewayGroup' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateGatewayGroup' :: CreateGatewayGroup -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateGatewayGroup
s@CreateGatewayGroup' {} Maybe [Tag]
a -> CreateGatewayGroup
s {$sel:tags:CreateGatewayGroup' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateGatewayGroup) 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 gateway group.
createGatewayGroup_name :: Lens.Lens' CreateGatewayGroup Prelude.Text
createGatewayGroup_name :: Lens' CreateGatewayGroup Text
createGatewayGroup_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateGatewayGroup' {Text
name :: Text
$sel:name:CreateGatewayGroup' :: CreateGatewayGroup -> Text
name} -> Text
name) (\s :: CreateGatewayGroup
s@CreateGatewayGroup' {} Text
a -> CreateGatewayGroup
s {$sel:name:CreateGatewayGroup' :: Text
name = Text
a} :: CreateGatewayGroup)

-- | A unique, user-specified identifier for the request that ensures
-- idempotency.
createGatewayGroup_clientRequestToken :: Lens.Lens' CreateGatewayGroup Prelude.Text
createGatewayGroup_clientRequestToken :: Lens' CreateGatewayGroup Text
createGatewayGroup_clientRequestToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateGatewayGroup' {Text
clientRequestToken :: Text
$sel:clientRequestToken:CreateGatewayGroup' :: CreateGatewayGroup -> Text
clientRequestToken} -> Text
clientRequestToken) (\s :: CreateGatewayGroup
s@CreateGatewayGroup' {} Text
a -> CreateGatewayGroup
s {$sel:clientRequestToken:CreateGatewayGroup' :: Text
clientRequestToken = Text
a} :: CreateGatewayGroup)

instance Core.AWSRequest CreateGatewayGroup where
  type
    AWSResponse CreateGatewayGroup =
      CreateGatewayGroupResponse
  request :: (Service -> Service)
-> CreateGatewayGroup -> Request CreateGatewayGroup
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 CreateGatewayGroup
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateGatewayGroup)))
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 -> Int -> CreateGatewayGroupResponse
CreateGatewayGroupResponse'
            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
"GatewayGroupArn")
            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 CreateGatewayGroup where
  hashWithSalt :: Int -> CreateGatewayGroup -> Int
hashWithSalt Int
_salt CreateGatewayGroup' {Maybe [Tag]
Maybe Text
Text
clientRequestToken :: Text
name :: Text
tags :: Maybe [Tag]
description :: Maybe Text
$sel:clientRequestToken:CreateGatewayGroup' :: CreateGatewayGroup -> Text
$sel:name:CreateGatewayGroup' :: CreateGatewayGroup -> Text
$sel:tags:CreateGatewayGroup' :: CreateGatewayGroup -> Maybe [Tag]
$sel:description:CreateGatewayGroup' :: CreateGatewayGroup -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
clientRequestToken

instance Prelude.NFData CreateGatewayGroup where
  rnf :: CreateGatewayGroup -> ()
rnf CreateGatewayGroup' {Maybe [Tag]
Maybe Text
Text
clientRequestToken :: Text
name :: Text
tags :: Maybe [Tag]
description :: Maybe Text
$sel:clientRequestToken:CreateGatewayGroup' :: CreateGatewayGroup -> Text
$sel:name:CreateGatewayGroup' :: CreateGatewayGroup -> Text
$sel:tags:CreateGatewayGroup' :: CreateGatewayGroup -> Maybe [Tag]
$sel:description:CreateGatewayGroup' :: CreateGatewayGroup -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
clientRequestToken

instance Data.ToHeaders CreateGatewayGroup where
  toHeaders :: CreateGatewayGroup -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"AlexaForBusiness.CreateGatewayGroup" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON CreateGatewayGroup where
  toJSON :: CreateGatewayGroup -> Value
toJSON CreateGatewayGroup' {Maybe [Tag]
Maybe Text
Text
clientRequestToken :: Text
name :: Text
tags :: Maybe [Tag]
description :: Maybe Text
$sel:clientRequestToken:CreateGatewayGroup' :: CreateGatewayGroup -> Text
$sel:name:CreateGatewayGroup' :: CreateGatewayGroup -> Text
$sel:tags:CreateGatewayGroup' :: CreateGatewayGroup -> Maybe [Tag]
$sel:description:CreateGatewayGroup' :: CreateGatewayGroup -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Description" 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
description,
            (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 [Tag]
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"Name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"ClientRequestToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
clientRequestToken)
          ]
      )

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

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

-- | /See:/ 'newCreateGatewayGroupResponse' smart constructor.
data CreateGatewayGroupResponse = CreateGatewayGroupResponse'
  { -- | The ARN of the created gateway group.
    CreateGatewayGroupResponse -> Maybe Text
gatewayGroupArn :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateGatewayGroupResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateGatewayGroupResponse -> CreateGatewayGroupResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateGatewayGroupResponse -> CreateGatewayGroupResponse -> Bool
$c/= :: CreateGatewayGroupResponse -> CreateGatewayGroupResponse -> Bool
== :: CreateGatewayGroupResponse -> CreateGatewayGroupResponse -> Bool
$c== :: CreateGatewayGroupResponse -> CreateGatewayGroupResponse -> Bool
Prelude.Eq, ReadPrec [CreateGatewayGroupResponse]
ReadPrec CreateGatewayGroupResponse
Int -> ReadS CreateGatewayGroupResponse
ReadS [CreateGatewayGroupResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateGatewayGroupResponse]
$creadListPrec :: ReadPrec [CreateGatewayGroupResponse]
readPrec :: ReadPrec CreateGatewayGroupResponse
$creadPrec :: ReadPrec CreateGatewayGroupResponse
readList :: ReadS [CreateGatewayGroupResponse]
$creadList :: ReadS [CreateGatewayGroupResponse]
readsPrec :: Int -> ReadS CreateGatewayGroupResponse
$creadsPrec :: Int -> ReadS CreateGatewayGroupResponse
Prelude.Read, Int -> CreateGatewayGroupResponse -> ShowS
[CreateGatewayGroupResponse] -> ShowS
CreateGatewayGroupResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateGatewayGroupResponse] -> ShowS
$cshowList :: [CreateGatewayGroupResponse] -> ShowS
show :: CreateGatewayGroupResponse -> String
$cshow :: CreateGatewayGroupResponse -> String
showsPrec :: Int -> CreateGatewayGroupResponse -> ShowS
$cshowsPrec :: Int -> CreateGatewayGroupResponse -> ShowS
Prelude.Show, forall x.
Rep CreateGatewayGroupResponse x -> CreateGatewayGroupResponse
forall x.
CreateGatewayGroupResponse -> Rep CreateGatewayGroupResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateGatewayGroupResponse x -> CreateGatewayGroupResponse
$cfrom :: forall x.
CreateGatewayGroupResponse -> Rep CreateGatewayGroupResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateGatewayGroupResponse' 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:
--
-- 'gatewayGroupArn', 'createGatewayGroupResponse_gatewayGroupArn' - The ARN of the created gateway group.
--
-- 'httpStatus', 'createGatewayGroupResponse_httpStatus' - The response's http status code.
newCreateGatewayGroupResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateGatewayGroupResponse
newCreateGatewayGroupResponse :: Int -> CreateGatewayGroupResponse
newCreateGatewayGroupResponse Int
pHttpStatus_ =
  CreateGatewayGroupResponse'
    { $sel:gatewayGroupArn:CreateGatewayGroupResponse' :: Maybe Text
gatewayGroupArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateGatewayGroupResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ARN of the created gateway group.
createGatewayGroupResponse_gatewayGroupArn :: Lens.Lens' CreateGatewayGroupResponse (Prelude.Maybe Prelude.Text)
createGatewayGroupResponse_gatewayGroupArn :: Lens' CreateGatewayGroupResponse (Maybe Text)
createGatewayGroupResponse_gatewayGroupArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateGatewayGroupResponse' {Maybe Text
gatewayGroupArn :: Maybe Text
$sel:gatewayGroupArn:CreateGatewayGroupResponse' :: CreateGatewayGroupResponse -> Maybe Text
gatewayGroupArn} -> Maybe Text
gatewayGroupArn) (\s :: CreateGatewayGroupResponse
s@CreateGatewayGroupResponse' {} Maybe Text
a -> CreateGatewayGroupResponse
s {$sel:gatewayGroupArn:CreateGatewayGroupResponse' :: Maybe Text
gatewayGroupArn = Maybe Text
a} :: CreateGatewayGroupResponse)

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

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