{-# 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.GamesParks.StartGeneratedCodeJob
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Starts an asynchronous process that generates client code for
-- system-defined and custom messages. The resulting code is collected as a
-- .zip file and uploaded to a pre-signed Amazon S3 URL.
module Amazonka.GamesParks.StartGeneratedCodeJob
  ( -- * Creating a Request
    StartGeneratedCodeJob (..),
    newStartGeneratedCodeJob,

    -- * Request Lenses
    startGeneratedCodeJob_gameName,
    startGeneratedCodeJob_generator,
    startGeneratedCodeJob_snapshotId,

    -- * Destructuring the Response
    StartGeneratedCodeJobResponse (..),
    newStartGeneratedCodeJobResponse,

    -- * Response Lenses
    startGeneratedCodeJobResponse_generatedCodeJobId,
    startGeneratedCodeJobResponse_httpStatus,
  )
where

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

-- | /See:/ 'newStartGeneratedCodeJob' smart constructor.
data StartGeneratedCodeJob = StartGeneratedCodeJob'
  { -- | The name of the game.
    StartGeneratedCodeJob -> Text
gameName :: Prelude.Text,
    -- | Properties of the generator to use for the job.
    StartGeneratedCodeJob -> Generator
generator :: Generator,
    -- | The identifier of the snapshot for which to generate code.
    StartGeneratedCodeJob -> Text
snapshotId :: Prelude.Text
  }
  deriving (StartGeneratedCodeJob -> StartGeneratedCodeJob -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartGeneratedCodeJob -> StartGeneratedCodeJob -> Bool
$c/= :: StartGeneratedCodeJob -> StartGeneratedCodeJob -> Bool
== :: StartGeneratedCodeJob -> StartGeneratedCodeJob -> Bool
$c== :: StartGeneratedCodeJob -> StartGeneratedCodeJob -> Bool
Prelude.Eq, ReadPrec [StartGeneratedCodeJob]
ReadPrec StartGeneratedCodeJob
Int -> ReadS StartGeneratedCodeJob
ReadS [StartGeneratedCodeJob]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartGeneratedCodeJob]
$creadListPrec :: ReadPrec [StartGeneratedCodeJob]
readPrec :: ReadPrec StartGeneratedCodeJob
$creadPrec :: ReadPrec StartGeneratedCodeJob
readList :: ReadS [StartGeneratedCodeJob]
$creadList :: ReadS [StartGeneratedCodeJob]
readsPrec :: Int -> ReadS StartGeneratedCodeJob
$creadsPrec :: Int -> ReadS StartGeneratedCodeJob
Prelude.Read, Int -> StartGeneratedCodeJob -> ShowS
[StartGeneratedCodeJob] -> ShowS
StartGeneratedCodeJob -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartGeneratedCodeJob] -> ShowS
$cshowList :: [StartGeneratedCodeJob] -> ShowS
show :: StartGeneratedCodeJob -> String
$cshow :: StartGeneratedCodeJob -> String
showsPrec :: Int -> StartGeneratedCodeJob -> ShowS
$cshowsPrec :: Int -> StartGeneratedCodeJob -> ShowS
Prelude.Show, forall x. Rep StartGeneratedCodeJob x -> StartGeneratedCodeJob
forall x. StartGeneratedCodeJob -> Rep StartGeneratedCodeJob x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartGeneratedCodeJob x -> StartGeneratedCodeJob
$cfrom :: forall x. StartGeneratedCodeJob -> Rep StartGeneratedCodeJob x
Prelude.Generic)

-- |
-- Create a value of 'StartGeneratedCodeJob' 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:
--
-- 'gameName', 'startGeneratedCodeJob_gameName' - The name of the game.
--
-- 'generator', 'startGeneratedCodeJob_generator' - Properties of the generator to use for the job.
--
-- 'snapshotId', 'startGeneratedCodeJob_snapshotId' - The identifier of the snapshot for which to generate code.
newStartGeneratedCodeJob ::
  -- | 'gameName'
  Prelude.Text ->
  -- | 'generator'
  Generator ->
  -- | 'snapshotId'
  Prelude.Text ->
  StartGeneratedCodeJob
newStartGeneratedCodeJob :: Text -> Generator -> Text -> StartGeneratedCodeJob
newStartGeneratedCodeJob
  Text
pGameName_
  Generator
pGenerator_
  Text
pSnapshotId_ =
    StartGeneratedCodeJob'
      { $sel:gameName:StartGeneratedCodeJob' :: Text
gameName = Text
pGameName_,
        $sel:generator:StartGeneratedCodeJob' :: Generator
generator = Generator
pGenerator_,
        $sel:snapshotId:StartGeneratedCodeJob' :: Text
snapshotId = Text
pSnapshotId_
      }

-- | The name of the game.
startGeneratedCodeJob_gameName :: Lens.Lens' StartGeneratedCodeJob Prelude.Text
startGeneratedCodeJob_gameName :: Lens' StartGeneratedCodeJob Text
startGeneratedCodeJob_gameName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartGeneratedCodeJob' {Text
gameName :: Text
$sel:gameName:StartGeneratedCodeJob' :: StartGeneratedCodeJob -> Text
gameName} -> Text
gameName) (\s :: StartGeneratedCodeJob
s@StartGeneratedCodeJob' {} Text
a -> StartGeneratedCodeJob
s {$sel:gameName:StartGeneratedCodeJob' :: Text
gameName = Text
a} :: StartGeneratedCodeJob)

-- | Properties of the generator to use for the job.
startGeneratedCodeJob_generator :: Lens.Lens' StartGeneratedCodeJob Generator
startGeneratedCodeJob_generator :: Lens' StartGeneratedCodeJob Generator
startGeneratedCodeJob_generator = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartGeneratedCodeJob' {Generator
generator :: Generator
$sel:generator:StartGeneratedCodeJob' :: StartGeneratedCodeJob -> Generator
generator} -> Generator
generator) (\s :: StartGeneratedCodeJob
s@StartGeneratedCodeJob' {} Generator
a -> StartGeneratedCodeJob
s {$sel:generator:StartGeneratedCodeJob' :: Generator
generator = Generator
a} :: StartGeneratedCodeJob)

-- | The identifier of the snapshot for which to generate code.
startGeneratedCodeJob_snapshotId :: Lens.Lens' StartGeneratedCodeJob Prelude.Text
startGeneratedCodeJob_snapshotId :: Lens' StartGeneratedCodeJob Text
startGeneratedCodeJob_snapshotId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartGeneratedCodeJob' {Text
snapshotId :: Text
$sel:snapshotId:StartGeneratedCodeJob' :: StartGeneratedCodeJob -> Text
snapshotId} -> Text
snapshotId) (\s :: StartGeneratedCodeJob
s@StartGeneratedCodeJob' {} Text
a -> StartGeneratedCodeJob
s {$sel:snapshotId:StartGeneratedCodeJob' :: Text
snapshotId = Text
a} :: StartGeneratedCodeJob)

instance Core.AWSRequest StartGeneratedCodeJob where
  type
    AWSResponse StartGeneratedCodeJob =
      StartGeneratedCodeJobResponse
  request :: (Service -> Service)
-> StartGeneratedCodeJob -> Request StartGeneratedCodeJob
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 StartGeneratedCodeJob
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse StartGeneratedCodeJob)))
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 -> StartGeneratedCodeJobResponse
StartGeneratedCodeJobResponse'
            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
"GeneratedCodeJobId")
            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 StartGeneratedCodeJob where
  hashWithSalt :: Int -> StartGeneratedCodeJob -> Int
hashWithSalt Int
_salt StartGeneratedCodeJob' {Text
Generator
snapshotId :: Text
generator :: Generator
gameName :: Text
$sel:snapshotId:StartGeneratedCodeJob' :: StartGeneratedCodeJob -> Text
$sel:generator:StartGeneratedCodeJob' :: StartGeneratedCodeJob -> Generator
$sel:gameName:StartGeneratedCodeJob' :: StartGeneratedCodeJob -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
gameName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Generator
generator
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
snapshotId

instance Prelude.NFData StartGeneratedCodeJob where
  rnf :: StartGeneratedCodeJob -> ()
rnf StartGeneratedCodeJob' {Text
Generator
snapshotId :: Text
generator :: Generator
gameName :: Text
$sel:snapshotId:StartGeneratedCodeJob' :: StartGeneratedCodeJob -> Text
$sel:generator:StartGeneratedCodeJob' :: StartGeneratedCodeJob -> Generator
$sel:gameName:StartGeneratedCodeJob' :: StartGeneratedCodeJob -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
gameName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Generator
generator
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
snapshotId

instance Data.ToHeaders StartGeneratedCodeJob where
  toHeaders :: StartGeneratedCodeJob -> 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 StartGeneratedCodeJob where
  toJSON :: StartGeneratedCodeJob -> Value
toJSON StartGeneratedCodeJob' {Text
Generator
snapshotId :: Text
generator :: Generator
gameName :: Text
$sel:snapshotId:StartGeneratedCodeJob' :: StartGeneratedCodeJob -> Text
$sel:generator:StartGeneratedCodeJob' :: StartGeneratedCodeJob -> Generator
$sel:gameName:StartGeneratedCodeJob' :: StartGeneratedCodeJob -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [forall a. a -> Maybe a
Prelude.Just (Key
"Generator" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Generator
generator)]
      )

instance Data.ToPath StartGeneratedCodeJob where
  toPath :: StartGeneratedCodeJob -> ByteString
toPath StartGeneratedCodeJob' {Text
Generator
snapshotId :: Text
generator :: Generator
gameName :: Text
$sel:snapshotId:StartGeneratedCodeJob' :: StartGeneratedCodeJob -> Text
$sel:generator:StartGeneratedCodeJob' :: StartGeneratedCodeJob -> Generator
$sel:gameName:StartGeneratedCodeJob' :: StartGeneratedCodeJob -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/game/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
gameName,
        ByteString
"/snapshot/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
snapshotId,
        ByteString
"/generated-sdk-code-job"
      ]

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

-- | /See:/ 'newStartGeneratedCodeJobResponse' smart constructor.
data StartGeneratedCodeJobResponse = StartGeneratedCodeJobResponse'
  { -- | The identifier of the code generation job. You can use this identifier
    -- in the @GetGeneratedCodeJob@ operation.
    StartGeneratedCodeJobResponse -> Maybe Text
generatedCodeJobId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    StartGeneratedCodeJobResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (StartGeneratedCodeJobResponse
-> StartGeneratedCodeJobResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartGeneratedCodeJobResponse
-> StartGeneratedCodeJobResponse -> Bool
$c/= :: StartGeneratedCodeJobResponse
-> StartGeneratedCodeJobResponse -> Bool
== :: StartGeneratedCodeJobResponse
-> StartGeneratedCodeJobResponse -> Bool
$c== :: StartGeneratedCodeJobResponse
-> StartGeneratedCodeJobResponse -> Bool
Prelude.Eq, ReadPrec [StartGeneratedCodeJobResponse]
ReadPrec StartGeneratedCodeJobResponse
Int -> ReadS StartGeneratedCodeJobResponse
ReadS [StartGeneratedCodeJobResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartGeneratedCodeJobResponse]
$creadListPrec :: ReadPrec [StartGeneratedCodeJobResponse]
readPrec :: ReadPrec StartGeneratedCodeJobResponse
$creadPrec :: ReadPrec StartGeneratedCodeJobResponse
readList :: ReadS [StartGeneratedCodeJobResponse]
$creadList :: ReadS [StartGeneratedCodeJobResponse]
readsPrec :: Int -> ReadS StartGeneratedCodeJobResponse
$creadsPrec :: Int -> ReadS StartGeneratedCodeJobResponse
Prelude.Read, Int -> StartGeneratedCodeJobResponse -> ShowS
[StartGeneratedCodeJobResponse] -> ShowS
StartGeneratedCodeJobResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartGeneratedCodeJobResponse] -> ShowS
$cshowList :: [StartGeneratedCodeJobResponse] -> ShowS
show :: StartGeneratedCodeJobResponse -> String
$cshow :: StartGeneratedCodeJobResponse -> String
showsPrec :: Int -> StartGeneratedCodeJobResponse -> ShowS
$cshowsPrec :: Int -> StartGeneratedCodeJobResponse -> ShowS
Prelude.Show, forall x.
Rep StartGeneratedCodeJobResponse x
-> StartGeneratedCodeJobResponse
forall x.
StartGeneratedCodeJobResponse
-> Rep StartGeneratedCodeJobResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep StartGeneratedCodeJobResponse x
-> StartGeneratedCodeJobResponse
$cfrom :: forall x.
StartGeneratedCodeJobResponse
-> Rep StartGeneratedCodeJobResponse x
Prelude.Generic)

-- |
-- Create a value of 'StartGeneratedCodeJobResponse' 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:
--
-- 'generatedCodeJobId', 'startGeneratedCodeJobResponse_generatedCodeJobId' - The identifier of the code generation job. You can use this identifier
-- in the @GetGeneratedCodeJob@ operation.
--
-- 'httpStatus', 'startGeneratedCodeJobResponse_httpStatus' - The response's http status code.
newStartGeneratedCodeJobResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  StartGeneratedCodeJobResponse
newStartGeneratedCodeJobResponse :: Int -> StartGeneratedCodeJobResponse
newStartGeneratedCodeJobResponse Int
pHttpStatus_ =
  StartGeneratedCodeJobResponse'
    { $sel:generatedCodeJobId:StartGeneratedCodeJobResponse' :: Maybe Text
generatedCodeJobId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:StartGeneratedCodeJobResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The identifier of the code generation job. You can use this identifier
-- in the @GetGeneratedCodeJob@ operation.
startGeneratedCodeJobResponse_generatedCodeJobId :: Lens.Lens' StartGeneratedCodeJobResponse (Prelude.Maybe Prelude.Text)
startGeneratedCodeJobResponse_generatedCodeJobId :: Lens' StartGeneratedCodeJobResponse (Maybe Text)
startGeneratedCodeJobResponse_generatedCodeJobId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartGeneratedCodeJobResponse' {Maybe Text
generatedCodeJobId :: Maybe Text
$sel:generatedCodeJobId:StartGeneratedCodeJobResponse' :: StartGeneratedCodeJobResponse -> Maybe Text
generatedCodeJobId} -> Maybe Text
generatedCodeJobId) (\s :: StartGeneratedCodeJobResponse
s@StartGeneratedCodeJobResponse' {} Maybe Text
a -> StartGeneratedCodeJobResponse
s {$sel:generatedCodeJobId:StartGeneratedCodeJobResponse' :: Maybe Text
generatedCodeJobId = Maybe Text
a} :: StartGeneratedCodeJobResponse)

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

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