{-# 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.GameLift.CreateLocation
-- 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 custom location for use in an Anywhere fleet.
module Amazonka.GameLift.CreateLocation
  ( -- * Creating a Request
    CreateLocation (..),
    newCreateLocation,

    -- * Request Lenses
    createLocation_tags,
    createLocation_locationName,

    -- * Destructuring the Response
    CreateLocationResponse (..),
    newCreateLocationResponse,

    -- * Response Lenses
    createLocationResponse_location,
    createLocationResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateLocation' smart constructor.
data CreateLocation = CreateLocation'
  { -- | A list of labels to assign to the new matchmaking configuration
    -- resource. Tags are developer-defined key-value pairs. Tagging Amazon Web
    -- Services resources are useful for resource management, access management
    -- and cost allocation. For more information, see
    -- <https://docs.aws.amazon.com/general/latest/gr/aws_tagging.html Tagging Amazon Web Services Resources>
    -- in the /Amazon Web Services General Rareference/.
    CreateLocation -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | A descriptive name for the custom location.
    CreateLocation -> Text
locationName :: Prelude.Text
  }
  deriving (CreateLocation -> CreateLocation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateLocation -> CreateLocation -> Bool
$c/= :: CreateLocation -> CreateLocation -> Bool
== :: CreateLocation -> CreateLocation -> Bool
$c== :: CreateLocation -> CreateLocation -> Bool
Prelude.Eq, ReadPrec [CreateLocation]
ReadPrec CreateLocation
Int -> ReadS CreateLocation
ReadS [CreateLocation]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateLocation]
$creadListPrec :: ReadPrec [CreateLocation]
readPrec :: ReadPrec CreateLocation
$creadPrec :: ReadPrec CreateLocation
readList :: ReadS [CreateLocation]
$creadList :: ReadS [CreateLocation]
readsPrec :: Int -> ReadS CreateLocation
$creadsPrec :: Int -> ReadS CreateLocation
Prelude.Read, Int -> CreateLocation -> ShowS
[CreateLocation] -> ShowS
CreateLocation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateLocation] -> ShowS
$cshowList :: [CreateLocation] -> ShowS
show :: CreateLocation -> String
$cshow :: CreateLocation -> String
showsPrec :: Int -> CreateLocation -> ShowS
$cshowsPrec :: Int -> CreateLocation -> ShowS
Prelude.Show, forall x. Rep CreateLocation x -> CreateLocation
forall x. CreateLocation -> Rep CreateLocation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateLocation x -> CreateLocation
$cfrom :: forall x. CreateLocation -> Rep CreateLocation x
Prelude.Generic)

-- |
-- Create a value of 'CreateLocation' 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', 'createLocation_tags' - A list of labels to assign to the new matchmaking configuration
-- resource. Tags are developer-defined key-value pairs. Tagging Amazon Web
-- Services resources are useful for resource management, access management
-- and cost allocation. For more information, see
-- <https://docs.aws.amazon.com/general/latest/gr/aws_tagging.html Tagging Amazon Web Services Resources>
-- in the /Amazon Web Services General Rareference/.
--
-- 'locationName', 'createLocation_locationName' - A descriptive name for the custom location.
newCreateLocation ::
  -- | 'locationName'
  Prelude.Text ->
  CreateLocation
newCreateLocation :: Text -> CreateLocation
newCreateLocation Text
pLocationName_ =
  CreateLocation'
    { $sel:tags:CreateLocation' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:locationName:CreateLocation' :: Text
locationName = Text
pLocationName_
    }

-- | A list of labels to assign to the new matchmaking configuration
-- resource. Tags are developer-defined key-value pairs. Tagging Amazon Web
-- Services resources are useful for resource management, access management
-- and cost allocation. For more information, see
-- <https://docs.aws.amazon.com/general/latest/gr/aws_tagging.html Tagging Amazon Web Services Resources>
-- in the /Amazon Web Services General Rareference/.
createLocation_tags :: Lens.Lens' CreateLocation (Prelude.Maybe [Tag])
createLocation_tags :: Lens' CreateLocation (Maybe [Tag])
createLocation_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLocation' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateLocation' :: CreateLocation -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateLocation
s@CreateLocation' {} Maybe [Tag]
a -> CreateLocation
s {$sel:tags:CreateLocation' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateLocation) 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

-- | A descriptive name for the custom location.
createLocation_locationName :: Lens.Lens' CreateLocation Prelude.Text
createLocation_locationName :: Lens' CreateLocation Text
createLocation_locationName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLocation' {Text
locationName :: Text
$sel:locationName:CreateLocation' :: CreateLocation -> Text
locationName} -> Text
locationName) (\s :: CreateLocation
s@CreateLocation' {} Text
a -> CreateLocation
s {$sel:locationName:CreateLocation' :: Text
locationName = Text
a} :: CreateLocation)

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

instance Prelude.NFData CreateLocation where
  rnf :: CreateLocation -> ()
rnf CreateLocation' {Maybe [Tag]
Text
locationName :: Text
tags :: Maybe [Tag]
$sel:locationName:CreateLocation' :: CreateLocation -> Text
$sel:tags:CreateLocation' :: CreateLocation -> Maybe [Tag]
..} =
    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
locationName

instance Data.ToHeaders CreateLocation where
  toHeaders :: CreateLocation -> 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
"GameLift.CreateLocation" :: 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 CreateLocation where
  toJSON :: CreateLocation -> Value
toJSON CreateLocation' {Maybe [Tag]
Text
locationName :: Text
tags :: Maybe [Tag]
$sel:locationName:CreateLocation' :: CreateLocation -> Text
$sel:tags:CreateLocation' :: CreateLocation -> Maybe [Tag]
..} =
    [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 [Tag]
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"LocationName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
locationName)
          ]
      )

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

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

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

-- |
-- Create a value of 'CreateLocationResponse' 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:
--
-- 'location', 'createLocationResponse_location' - The details of the custom location you created.
--
-- 'httpStatus', 'createLocationResponse_httpStatus' - The response's http status code.
newCreateLocationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateLocationResponse
newCreateLocationResponse :: Int -> CreateLocationResponse
newCreateLocationResponse Int
pHttpStatus_ =
  CreateLocationResponse'
    { $sel:location:CreateLocationResponse' :: Maybe LocationModel
location = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateLocationResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The details of the custom location you created.
createLocationResponse_location :: Lens.Lens' CreateLocationResponse (Prelude.Maybe LocationModel)
createLocationResponse_location :: Lens' CreateLocationResponse (Maybe LocationModel)
createLocationResponse_location = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLocationResponse' {Maybe LocationModel
location :: Maybe LocationModel
$sel:location:CreateLocationResponse' :: CreateLocationResponse -> Maybe LocationModel
location} -> Maybe LocationModel
location) (\s :: CreateLocationResponse
s@CreateLocationResponse' {} Maybe LocationModel
a -> CreateLocationResponse
s {$sel:location:CreateLocationResponse' :: Maybe LocationModel
location = Maybe LocationModel
a} :: CreateLocationResponse)

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

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