{-# 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.Rekognition.StartProjectVersion
-- 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 the running of the version of a model. Starting a model takes a
-- while to complete. To check the current state of the model, use
-- DescribeProjectVersions.
--
-- Once the model is running, you can detect custom labels in new images by
-- calling DetectCustomLabels.
--
-- You are charged for the amount of time that the model is running. To
-- stop a running model, call StopProjectVersion.
--
-- For more information, see /Running a trained Amazon Rekognition Custom
-- Labels model/ in the Amazon Rekognition Custom Labels Guide.
--
-- This operation requires permissions to perform the
-- @rekognition:StartProjectVersion@ action.
module Amazonka.Rekognition.StartProjectVersion
  ( -- * Creating a Request
    StartProjectVersion (..),
    newStartProjectVersion,

    -- * Request Lenses
    startProjectVersion_maxInferenceUnits,
    startProjectVersion_projectVersionArn,
    startProjectVersion_minInferenceUnits,

    -- * Destructuring the Response
    StartProjectVersionResponse (..),
    newStartProjectVersionResponse,

    -- * Response Lenses
    startProjectVersionResponse_status,
    startProjectVersionResponse_httpStatus,
  )
where

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 Amazonka.Rekognition.Types
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newStartProjectVersion' smart constructor.
data StartProjectVersion = StartProjectVersion'
  { -- | The maximum number of inference units to use for auto-scaling the model.
    -- If you don\'t specify a value, Amazon Rekognition Custom Labels doesn\'t
    -- auto-scale the model.
    StartProjectVersion -> Maybe Natural
maxInferenceUnits :: Prelude.Maybe Prelude.Natural,
    -- | The Amazon Resource Name(ARN) of the model version that you want to
    -- start.
    StartProjectVersion -> Text
projectVersionArn :: Prelude.Text,
    -- | The minimum number of inference units to use. A single inference unit
    -- represents 1 hour of processing.
    --
    -- For information about the number of transactions per second (TPS) that
    -- an inference unit can support, see /Running a trained Amazon Rekognition
    -- Custom Labels model/ in the Amazon Rekognition Custom Labels Guide.
    --
    -- Use a higher number to increase the TPS throughput of your model. You
    -- are charged for the number of inference units that you use.
    StartProjectVersion -> Natural
minInferenceUnits :: Prelude.Natural
  }
  deriving (StartProjectVersion -> StartProjectVersion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartProjectVersion -> StartProjectVersion -> Bool
$c/= :: StartProjectVersion -> StartProjectVersion -> Bool
== :: StartProjectVersion -> StartProjectVersion -> Bool
$c== :: StartProjectVersion -> StartProjectVersion -> Bool
Prelude.Eq, ReadPrec [StartProjectVersion]
ReadPrec StartProjectVersion
Int -> ReadS StartProjectVersion
ReadS [StartProjectVersion]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartProjectVersion]
$creadListPrec :: ReadPrec [StartProjectVersion]
readPrec :: ReadPrec StartProjectVersion
$creadPrec :: ReadPrec StartProjectVersion
readList :: ReadS [StartProjectVersion]
$creadList :: ReadS [StartProjectVersion]
readsPrec :: Int -> ReadS StartProjectVersion
$creadsPrec :: Int -> ReadS StartProjectVersion
Prelude.Read, Int -> StartProjectVersion -> ShowS
[StartProjectVersion] -> ShowS
StartProjectVersion -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartProjectVersion] -> ShowS
$cshowList :: [StartProjectVersion] -> ShowS
show :: StartProjectVersion -> String
$cshow :: StartProjectVersion -> String
showsPrec :: Int -> StartProjectVersion -> ShowS
$cshowsPrec :: Int -> StartProjectVersion -> ShowS
Prelude.Show, forall x. Rep StartProjectVersion x -> StartProjectVersion
forall x. StartProjectVersion -> Rep StartProjectVersion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartProjectVersion x -> StartProjectVersion
$cfrom :: forall x. StartProjectVersion -> Rep StartProjectVersion x
Prelude.Generic)

-- |
-- Create a value of 'StartProjectVersion' 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:
--
-- 'maxInferenceUnits', 'startProjectVersion_maxInferenceUnits' - The maximum number of inference units to use for auto-scaling the model.
-- If you don\'t specify a value, Amazon Rekognition Custom Labels doesn\'t
-- auto-scale the model.
--
-- 'projectVersionArn', 'startProjectVersion_projectVersionArn' - The Amazon Resource Name(ARN) of the model version that you want to
-- start.
--
-- 'minInferenceUnits', 'startProjectVersion_minInferenceUnits' - The minimum number of inference units to use. A single inference unit
-- represents 1 hour of processing.
--
-- For information about the number of transactions per second (TPS) that
-- an inference unit can support, see /Running a trained Amazon Rekognition
-- Custom Labels model/ in the Amazon Rekognition Custom Labels Guide.
--
-- Use a higher number to increase the TPS throughput of your model. You
-- are charged for the number of inference units that you use.
newStartProjectVersion ::
  -- | 'projectVersionArn'
  Prelude.Text ->
  -- | 'minInferenceUnits'
  Prelude.Natural ->
  StartProjectVersion
newStartProjectVersion :: Text -> Natural -> StartProjectVersion
newStartProjectVersion
  Text
pProjectVersionArn_
  Natural
pMinInferenceUnits_ =
    StartProjectVersion'
      { $sel:maxInferenceUnits:StartProjectVersion' :: Maybe Natural
maxInferenceUnits =
          forall a. Maybe a
Prelude.Nothing,
        $sel:projectVersionArn:StartProjectVersion' :: Text
projectVersionArn = Text
pProjectVersionArn_,
        $sel:minInferenceUnits:StartProjectVersion' :: Natural
minInferenceUnits = Natural
pMinInferenceUnits_
      }

-- | The maximum number of inference units to use for auto-scaling the model.
-- If you don\'t specify a value, Amazon Rekognition Custom Labels doesn\'t
-- auto-scale the model.
startProjectVersion_maxInferenceUnits :: Lens.Lens' StartProjectVersion (Prelude.Maybe Prelude.Natural)
startProjectVersion_maxInferenceUnits :: Lens' StartProjectVersion (Maybe Natural)
startProjectVersion_maxInferenceUnits = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartProjectVersion' {Maybe Natural
maxInferenceUnits :: Maybe Natural
$sel:maxInferenceUnits:StartProjectVersion' :: StartProjectVersion -> Maybe Natural
maxInferenceUnits} -> Maybe Natural
maxInferenceUnits) (\s :: StartProjectVersion
s@StartProjectVersion' {} Maybe Natural
a -> StartProjectVersion
s {$sel:maxInferenceUnits:StartProjectVersion' :: Maybe Natural
maxInferenceUnits = Maybe Natural
a} :: StartProjectVersion)

-- | The Amazon Resource Name(ARN) of the model version that you want to
-- start.
startProjectVersion_projectVersionArn :: Lens.Lens' StartProjectVersion Prelude.Text
startProjectVersion_projectVersionArn :: Lens' StartProjectVersion Text
startProjectVersion_projectVersionArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartProjectVersion' {Text
projectVersionArn :: Text
$sel:projectVersionArn:StartProjectVersion' :: StartProjectVersion -> Text
projectVersionArn} -> Text
projectVersionArn) (\s :: StartProjectVersion
s@StartProjectVersion' {} Text
a -> StartProjectVersion
s {$sel:projectVersionArn:StartProjectVersion' :: Text
projectVersionArn = Text
a} :: StartProjectVersion)

-- | The minimum number of inference units to use. A single inference unit
-- represents 1 hour of processing.
--
-- For information about the number of transactions per second (TPS) that
-- an inference unit can support, see /Running a trained Amazon Rekognition
-- Custom Labels model/ in the Amazon Rekognition Custom Labels Guide.
--
-- Use a higher number to increase the TPS throughput of your model. You
-- are charged for the number of inference units that you use.
startProjectVersion_minInferenceUnits :: Lens.Lens' StartProjectVersion Prelude.Natural
startProjectVersion_minInferenceUnits :: Lens' StartProjectVersion Natural
startProjectVersion_minInferenceUnits = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartProjectVersion' {Natural
minInferenceUnits :: Natural
$sel:minInferenceUnits:StartProjectVersion' :: StartProjectVersion -> Natural
minInferenceUnits} -> Natural
minInferenceUnits) (\s :: StartProjectVersion
s@StartProjectVersion' {} Natural
a -> StartProjectVersion
s {$sel:minInferenceUnits:StartProjectVersion' :: Natural
minInferenceUnits = Natural
a} :: StartProjectVersion)

instance Core.AWSRequest StartProjectVersion where
  type
    AWSResponse StartProjectVersion =
      StartProjectVersionResponse
  request :: (Service -> Service)
-> StartProjectVersion -> Request StartProjectVersion
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 StartProjectVersion
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse StartProjectVersion)))
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 ProjectVersionStatus -> Int -> StartProjectVersionResponse
StartProjectVersionResponse'
            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
"Status")
            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 StartProjectVersion where
  hashWithSalt :: Int -> StartProjectVersion -> Int
hashWithSalt Int
_salt StartProjectVersion' {Natural
Maybe Natural
Text
minInferenceUnits :: Natural
projectVersionArn :: Text
maxInferenceUnits :: Maybe Natural
$sel:minInferenceUnits:StartProjectVersion' :: StartProjectVersion -> Natural
$sel:projectVersionArn:StartProjectVersion' :: StartProjectVersion -> Text
$sel:maxInferenceUnits:StartProjectVersion' :: StartProjectVersion -> Maybe Natural
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxInferenceUnits
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
projectVersionArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Natural
minInferenceUnits

instance Prelude.NFData StartProjectVersion where
  rnf :: StartProjectVersion -> ()
rnf StartProjectVersion' {Natural
Maybe Natural
Text
minInferenceUnits :: Natural
projectVersionArn :: Text
maxInferenceUnits :: Maybe Natural
$sel:minInferenceUnits:StartProjectVersion' :: StartProjectVersion -> Natural
$sel:projectVersionArn:StartProjectVersion' :: StartProjectVersion -> Text
$sel:maxInferenceUnits:StartProjectVersion' :: StartProjectVersion -> Maybe Natural
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
maxInferenceUnits
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
projectVersionArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Natural
minInferenceUnits

instance Data.ToHeaders StartProjectVersion where
  toHeaders :: StartProjectVersion -> 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
"RekognitionService.StartProjectVersion" ::
                          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 StartProjectVersion where
  toJSON :: StartProjectVersion -> Value
toJSON StartProjectVersion' {Natural
Maybe Natural
Text
minInferenceUnits :: Natural
projectVersionArn :: Text
maxInferenceUnits :: Maybe Natural
$sel:minInferenceUnits:StartProjectVersion' :: StartProjectVersion -> Natural
$sel:projectVersionArn:StartProjectVersion' :: StartProjectVersion -> Text
$sel:maxInferenceUnits:StartProjectVersion' :: StartProjectVersion -> Maybe Natural
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"MaxInferenceUnits" 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 Natural
maxInferenceUnits,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"ProjectVersionArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
projectVersionArn),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"MinInferenceUnits" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Natural
minInferenceUnits)
          ]
      )

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

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

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

-- |
-- Create a value of 'StartProjectVersionResponse' 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:
--
-- 'status', 'startProjectVersionResponse_status' - The current running status of the model.
--
-- 'httpStatus', 'startProjectVersionResponse_httpStatus' - The response's http status code.
newStartProjectVersionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  StartProjectVersionResponse
newStartProjectVersionResponse :: Int -> StartProjectVersionResponse
newStartProjectVersionResponse Int
pHttpStatus_ =
  StartProjectVersionResponse'
    { $sel:status:StartProjectVersionResponse' :: Maybe ProjectVersionStatus
status =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:StartProjectVersionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The current running status of the model.
startProjectVersionResponse_status :: Lens.Lens' StartProjectVersionResponse (Prelude.Maybe ProjectVersionStatus)
startProjectVersionResponse_status :: Lens' StartProjectVersionResponse (Maybe ProjectVersionStatus)
startProjectVersionResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartProjectVersionResponse' {Maybe ProjectVersionStatus
status :: Maybe ProjectVersionStatus
$sel:status:StartProjectVersionResponse' :: StartProjectVersionResponse -> Maybe ProjectVersionStatus
status} -> Maybe ProjectVersionStatus
status) (\s :: StartProjectVersionResponse
s@StartProjectVersionResponse' {} Maybe ProjectVersionStatus
a -> StartProjectVersionResponse
s {$sel:status:StartProjectVersionResponse' :: Maybe ProjectVersionStatus
status = Maybe ProjectVersionStatus
a} :: StartProjectVersionResponse)

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

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