{-# 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.Personalize.StopSolutionVersionCreation
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Stops creating a solution version that is in a state of CREATE_PENDING
-- or CREATE IN_PROGRESS.
--
-- Depending on the current state of the solution version, the solution
-- version state changes as follows:
--
-- -   CREATE_PENDING > CREATE_STOPPED
--
--     or
--
-- -   CREATE_IN_PROGRESS > CREATE_STOPPING > CREATE_STOPPED
--
-- You are billed for all of the training completed up until you stop the
-- solution version creation. You cannot resume creating a solution version
-- once it has been stopped.
module Amazonka.Personalize.StopSolutionVersionCreation
  ( -- * Creating a Request
    StopSolutionVersionCreation (..),
    newStopSolutionVersionCreation,

    -- * Request Lenses
    stopSolutionVersionCreation_solutionVersionArn,

    -- * Destructuring the Response
    StopSolutionVersionCreationResponse (..),
    newStopSolutionVersionCreationResponse,
  )
where

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

-- | /See:/ 'newStopSolutionVersionCreation' smart constructor.
data StopSolutionVersionCreation = StopSolutionVersionCreation'
  { -- | The Amazon Resource Name (ARN) of the solution version you want to stop
    -- creating.
    StopSolutionVersionCreation -> Text
solutionVersionArn :: Prelude.Text
  }
  deriving (StopSolutionVersionCreation -> StopSolutionVersionCreation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StopSolutionVersionCreation -> StopSolutionVersionCreation -> Bool
$c/= :: StopSolutionVersionCreation -> StopSolutionVersionCreation -> Bool
== :: StopSolutionVersionCreation -> StopSolutionVersionCreation -> Bool
$c== :: StopSolutionVersionCreation -> StopSolutionVersionCreation -> Bool
Prelude.Eq, ReadPrec [StopSolutionVersionCreation]
ReadPrec StopSolutionVersionCreation
Int -> ReadS StopSolutionVersionCreation
ReadS [StopSolutionVersionCreation]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StopSolutionVersionCreation]
$creadListPrec :: ReadPrec [StopSolutionVersionCreation]
readPrec :: ReadPrec StopSolutionVersionCreation
$creadPrec :: ReadPrec StopSolutionVersionCreation
readList :: ReadS [StopSolutionVersionCreation]
$creadList :: ReadS [StopSolutionVersionCreation]
readsPrec :: Int -> ReadS StopSolutionVersionCreation
$creadsPrec :: Int -> ReadS StopSolutionVersionCreation
Prelude.Read, Int -> StopSolutionVersionCreation -> ShowS
[StopSolutionVersionCreation] -> ShowS
StopSolutionVersionCreation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StopSolutionVersionCreation] -> ShowS
$cshowList :: [StopSolutionVersionCreation] -> ShowS
show :: StopSolutionVersionCreation -> String
$cshow :: StopSolutionVersionCreation -> String
showsPrec :: Int -> StopSolutionVersionCreation -> ShowS
$cshowsPrec :: Int -> StopSolutionVersionCreation -> ShowS
Prelude.Show, forall x.
Rep StopSolutionVersionCreation x -> StopSolutionVersionCreation
forall x.
StopSolutionVersionCreation -> Rep StopSolutionVersionCreation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep StopSolutionVersionCreation x -> StopSolutionVersionCreation
$cfrom :: forall x.
StopSolutionVersionCreation -> Rep StopSolutionVersionCreation x
Prelude.Generic)

-- |
-- Create a value of 'StopSolutionVersionCreation' 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:
--
-- 'solutionVersionArn', 'stopSolutionVersionCreation_solutionVersionArn' - The Amazon Resource Name (ARN) of the solution version you want to stop
-- creating.
newStopSolutionVersionCreation ::
  -- | 'solutionVersionArn'
  Prelude.Text ->
  StopSolutionVersionCreation
newStopSolutionVersionCreation :: Text -> StopSolutionVersionCreation
newStopSolutionVersionCreation Text
pSolutionVersionArn_ =
  StopSolutionVersionCreation'
    { $sel:solutionVersionArn:StopSolutionVersionCreation' :: Text
solutionVersionArn =
        Text
pSolutionVersionArn_
    }

-- | The Amazon Resource Name (ARN) of the solution version you want to stop
-- creating.
stopSolutionVersionCreation_solutionVersionArn :: Lens.Lens' StopSolutionVersionCreation Prelude.Text
stopSolutionVersionCreation_solutionVersionArn :: Lens' StopSolutionVersionCreation Text
stopSolutionVersionCreation_solutionVersionArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StopSolutionVersionCreation' {Text
solutionVersionArn :: Text
$sel:solutionVersionArn:StopSolutionVersionCreation' :: StopSolutionVersionCreation -> Text
solutionVersionArn} -> Text
solutionVersionArn) (\s :: StopSolutionVersionCreation
s@StopSolutionVersionCreation' {} Text
a -> StopSolutionVersionCreation
s {$sel:solutionVersionArn:StopSolutionVersionCreation' :: Text
solutionVersionArn = Text
a} :: StopSolutionVersionCreation)

instance Core.AWSRequest StopSolutionVersionCreation where
  type
    AWSResponse StopSolutionVersionCreation =
      StopSolutionVersionCreationResponse
  request :: (Service -> Service)
-> StopSolutionVersionCreation
-> Request StopSolutionVersionCreation
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 StopSolutionVersionCreation
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse StopSolutionVersionCreation)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull
      StopSolutionVersionCreationResponse
StopSolutionVersionCreationResponse'

instance Prelude.Hashable StopSolutionVersionCreation where
  hashWithSalt :: Int -> StopSolutionVersionCreation -> Int
hashWithSalt Int
_salt StopSolutionVersionCreation' {Text
solutionVersionArn :: Text
$sel:solutionVersionArn:StopSolutionVersionCreation' :: StopSolutionVersionCreation -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
solutionVersionArn

instance Prelude.NFData StopSolutionVersionCreation where
  rnf :: StopSolutionVersionCreation -> ()
rnf StopSolutionVersionCreation' {Text
solutionVersionArn :: Text
$sel:solutionVersionArn:StopSolutionVersionCreation' :: StopSolutionVersionCreation -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
solutionVersionArn

instance Data.ToHeaders StopSolutionVersionCreation where
  toHeaders :: StopSolutionVersionCreation -> [Header]
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 -> [Header]
Data.=# ( ByteString
"AmazonPersonalize.StopSolutionVersionCreation" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON StopSolutionVersionCreation where
  toJSON :: StopSolutionVersionCreation -> Value
toJSON StopSolutionVersionCreation' {Text
solutionVersionArn :: Text
$sel:solutionVersionArn:StopSolutionVersionCreation' :: StopSolutionVersionCreation -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"solutionVersionArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
solutionVersionArn)
          ]
      )

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

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

-- | /See:/ 'newStopSolutionVersionCreationResponse' smart constructor.
data StopSolutionVersionCreationResponse = StopSolutionVersionCreationResponse'
  {
  }
  deriving (StopSolutionVersionCreationResponse
-> StopSolutionVersionCreationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StopSolutionVersionCreationResponse
-> StopSolutionVersionCreationResponse -> Bool
$c/= :: StopSolutionVersionCreationResponse
-> StopSolutionVersionCreationResponse -> Bool
== :: StopSolutionVersionCreationResponse
-> StopSolutionVersionCreationResponse -> Bool
$c== :: StopSolutionVersionCreationResponse
-> StopSolutionVersionCreationResponse -> Bool
Prelude.Eq, ReadPrec [StopSolutionVersionCreationResponse]
ReadPrec StopSolutionVersionCreationResponse
Int -> ReadS StopSolutionVersionCreationResponse
ReadS [StopSolutionVersionCreationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StopSolutionVersionCreationResponse]
$creadListPrec :: ReadPrec [StopSolutionVersionCreationResponse]
readPrec :: ReadPrec StopSolutionVersionCreationResponse
$creadPrec :: ReadPrec StopSolutionVersionCreationResponse
readList :: ReadS [StopSolutionVersionCreationResponse]
$creadList :: ReadS [StopSolutionVersionCreationResponse]
readsPrec :: Int -> ReadS StopSolutionVersionCreationResponse
$creadsPrec :: Int -> ReadS StopSolutionVersionCreationResponse
Prelude.Read, Int -> StopSolutionVersionCreationResponse -> ShowS
[StopSolutionVersionCreationResponse] -> ShowS
StopSolutionVersionCreationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StopSolutionVersionCreationResponse] -> ShowS
$cshowList :: [StopSolutionVersionCreationResponse] -> ShowS
show :: StopSolutionVersionCreationResponse -> String
$cshow :: StopSolutionVersionCreationResponse -> String
showsPrec :: Int -> StopSolutionVersionCreationResponse -> ShowS
$cshowsPrec :: Int -> StopSolutionVersionCreationResponse -> ShowS
Prelude.Show, forall x.
Rep StopSolutionVersionCreationResponse x
-> StopSolutionVersionCreationResponse
forall x.
StopSolutionVersionCreationResponse
-> Rep StopSolutionVersionCreationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep StopSolutionVersionCreationResponse x
-> StopSolutionVersionCreationResponse
$cfrom :: forall x.
StopSolutionVersionCreationResponse
-> Rep StopSolutionVersionCreationResponse x
Prelude.Generic)

-- |
-- Create a value of 'StopSolutionVersionCreationResponse' 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.
newStopSolutionVersionCreationResponse ::
  StopSolutionVersionCreationResponse
newStopSolutionVersionCreationResponse :: StopSolutionVersionCreationResponse
newStopSolutionVersionCreationResponse =
  StopSolutionVersionCreationResponse
StopSolutionVersionCreationResponse'

instance
  Prelude.NFData
    StopSolutionVersionCreationResponse
  where
  rnf :: StopSolutionVersionCreationResponse -> ()
rnf StopSolutionVersionCreationResponse
_ = ()