{-# 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.SageMaker.DescribeModel
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Describes a model that you created using the @CreateModel@ API.
module Amazonka.SageMaker.DescribeModel
  ( -- * Creating a Request
    DescribeModel (..),
    newDescribeModel,

    -- * Request Lenses
    describeModel_modelName,

    -- * Destructuring the Response
    DescribeModelResponse (..),
    newDescribeModelResponse,

    -- * Response Lenses
    describeModelResponse_containers,
    describeModelResponse_enableNetworkIsolation,
    describeModelResponse_inferenceExecutionConfig,
    describeModelResponse_primaryContainer,
    describeModelResponse_vpcConfig,
    describeModelResponse_httpStatus,
    describeModelResponse_modelName,
    describeModelResponse_executionRoleArn,
    describeModelResponse_creationTime,
    describeModelResponse_modelArn,
  )
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 qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response
import Amazonka.SageMaker.Types

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

-- |
-- Create a value of 'DescribeModel' 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:
--
-- 'modelName', 'describeModel_modelName' - The name of the model.
newDescribeModel ::
  -- | 'modelName'
  Prelude.Text ->
  DescribeModel
newDescribeModel :: Text -> DescribeModel
newDescribeModel Text
pModelName_ =
  DescribeModel' {$sel:modelName:DescribeModel' :: Text
modelName = Text
pModelName_}

-- | The name of the model.
describeModel_modelName :: Lens.Lens' DescribeModel Prelude.Text
describeModel_modelName :: Lens' DescribeModel Text
describeModel_modelName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeModel' {Text
modelName :: Text
$sel:modelName:DescribeModel' :: DescribeModel -> Text
modelName} -> Text
modelName) (\s :: DescribeModel
s@DescribeModel' {} Text
a -> DescribeModel
s {$sel:modelName:DescribeModel' :: Text
modelName = Text
a} :: DescribeModel)

instance Core.AWSRequest DescribeModel where
  type
    AWSResponse DescribeModel =
      DescribeModelResponse
  request :: (Service -> Service) -> DescribeModel -> Request DescribeModel
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 DescribeModel
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DescribeModel)))
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 [ContainerDefinition]
-> Maybe Bool
-> Maybe InferenceExecutionConfig
-> Maybe ContainerDefinition
-> Maybe VpcConfig
-> Int
-> Text
-> Text
-> POSIX
-> Text
-> DescribeModelResponse
DescribeModelResponse'
            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
"Containers" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"EnableNetworkIsolation")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"InferenceExecutionConfig")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"PrimaryContainer")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"VpcConfig")
            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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"ModelName")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"ExecutionRoleArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"CreationTime")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"ModelArn")
      )

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

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

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

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

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

-- | /See:/ 'newDescribeModelResponse' smart constructor.
data DescribeModelResponse = DescribeModelResponse'
  { -- | The containers in the inference pipeline.
    DescribeModelResponse -> Maybe [ContainerDefinition]
containers :: Prelude.Maybe [ContainerDefinition],
    -- | If @True@, no inbound or outbound network calls can be made to or from
    -- the model container.
    DescribeModelResponse -> Maybe Bool
enableNetworkIsolation :: Prelude.Maybe Prelude.Bool,
    -- | Specifies details of how containers in a multi-container endpoint are
    -- called.
    DescribeModelResponse -> Maybe InferenceExecutionConfig
inferenceExecutionConfig :: Prelude.Maybe InferenceExecutionConfig,
    -- | The location of the primary inference code, associated artifacts, and
    -- custom environment map that the inference code uses when it is deployed
    -- in production.
    DescribeModelResponse -> Maybe ContainerDefinition
primaryContainer :: Prelude.Maybe ContainerDefinition,
    -- | A VpcConfig object that specifies the VPC that this model has access to.
    -- For more information, see
    -- <https://docs.aws.amazon.com/sagemaker/latest/dg/host-vpc.html Protect Endpoints by Using an Amazon Virtual Private Cloud>
    DescribeModelResponse -> Maybe VpcConfig
vpcConfig :: Prelude.Maybe VpcConfig,
    -- | The response's http status code.
    DescribeModelResponse -> Int
httpStatus :: Prelude.Int,
    -- | Name of the SageMaker model.
    DescribeModelResponse -> Text
modelName :: Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the IAM role that you specified for
    -- the model.
    DescribeModelResponse -> Text
executionRoleArn :: Prelude.Text,
    -- | A timestamp that shows when the model was created.
    DescribeModelResponse -> POSIX
creationTime :: Data.POSIX,
    -- | The Amazon Resource Name (ARN) of the model.
    DescribeModelResponse -> Text
modelArn :: Prelude.Text
  }
  deriving (DescribeModelResponse -> DescribeModelResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeModelResponse -> DescribeModelResponse -> Bool
$c/= :: DescribeModelResponse -> DescribeModelResponse -> Bool
== :: DescribeModelResponse -> DescribeModelResponse -> Bool
$c== :: DescribeModelResponse -> DescribeModelResponse -> Bool
Prelude.Eq, ReadPrec [DescribeModelResponse]
ReadPrec DescribeModelResponse
Int -> ReadS DescribeModelResponse
ReadS [DescribeModelResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeModelResponse]
$creadListPrec :: ReadPrec [DescribeModelResponse]
readPrec :: ReadPrec DescribeModelResponse
$creadPrec :: ReadPrec DescribeModelResponse
readList :: ReadS [DescribeModelResponse]
$creadList :: ReadS [DescribeModelResponse]
readsPrec :: Int -> ReadS DescribeModelResponse
$creadsPrec :: Int -> ReadS DescribeModelResponse
Prelude.Read, Int -> DescribeModelResponse -> ShowS
[DescribeModelResponse] -> ShowS
DescribeModelResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeModelResponse] -> ShowS
$cshowList :: [DescribeModelResponse] -> ShowS
show :: DescribeModelResponse -> String
$cshow :: DescribeModelResponse -> String
showsPrec :: Int -> DescribeModelResponse -> ShowS
$cshowsPrec :: Int -> DescribeModelResponse -> ShowS
Prelude.Show, forall x. Rep DescribeModelResponse x -> DescribeModelResponse
forall x. DescribeModelResponse -> Rep DescribeModelResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeModelResponse x -> DescribeModelResponse
$cfrom :: forall x. DescribeModelResponse -> Rep DescribeModelResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeModelResponse' 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:
--
-- 'containers', 'describeModelResponse_containers' - The containers in the inference pipeline.
--
-- 'enableNetworkIsolation', 'describeModelResponse_enableNetworkIsolation' - If @True@, no inbound or outbound network calls can be made to or from
-- the model container.
--
-- 'inferenceExecutionConfig', 'describeModelResponse_inferenceExecutionConfig' - Specifies details of how containers in a multi-container endpoint are
-- called.
--
-- 'primaryContainer', 'describeModelResponse_primaryContainer' - The location of the primary inference code, associated artifacts, and
-- custom environment map that the inference code uses when it is deployed
-- in production.
--
-- 'vpcConfig', 'describeModelResponse_vpcConfig' - A VpcConfig object that specifies the VPC that this model has access to.
-- For more information, see
-- <https://docs.aws.amazon.com/sagemaker/latest/dg/host-vpc.html Protect Endpoints by Using an Amazon Virtual Private Cloud>
--
-- 'httpStatus', 'describeModelResponse_httpStatus' - The response's http status code.
--
-- 'modelName', 'describeModelResponse_modelName' - Name of the SageMaker model.
--
-- 'executionRoleArn', 'describeModelResponse_executionRoleArn' - The Amazon Resource Name (ARN) of the IAM role that you specified for
-- the model.
--
-- 'creationTime', 'describeModelResponse_creationTime' - A timestamp that shows when the model was created.
--
-- 'modelArn', 'describeModelResponse_modelArn' - The Amazon Resource Name (ARN) of the model.
newDescribeModelResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'modelName'
  Prelude.Text ->
  -- | 'executionRoleArn'
  Prelude.Text ->
  -- | 'creationTime'
  Prelude.UTCTime ->
  -- | 'modelArn'
  Prelude.Text ->
  DescribeModelResponse
newDescribeModelResponse :: Int -> Text -> Text -> UTCTime -> Text -> DescribeModelResponse
newDescribeModelResponse
  Int
pHttpStatus_
  Text
pModelName_
  Text
pExecutionRoleArn_
  UTCTime
pCreationTime_
  Text
pModelArn_ =
    DescribeModelResponse'
      { $sel:containers:DescribeModelResponse' :: Maybe [ContainerDefinition]
containers =
          forall a. Maybe a
Prelude.Nothing,
        $sel:enableNetworkIsolation:DescribeModelResponse' :: Maybe Bool
enableNetworkIsolation = forall a. Maybe a
Prelude.Nothing,
        $sel:inferenceExecutionConfig:DescribeModelResponse' :: Maybe InferenceExecutionConfig
inferenceExecutionConfig = forall a. Maybe a
Prelude.Nothing,
        $sel:primaryContainer:DescribeModelResponse' :: Maybe ContainerDefinition
primaryContainer = forall a. Maybe a
Prelude.Nothing,
        $sel:vpcConfig:DescribeModelResponse' :: Maybe VpcConfig
vpcConfig = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:DescribeModelResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:modelName:DescribeModelResponse' :: Text
modelName = Text
pModelName_,
        $sel:executionRoleArn:DescribeModelResponse' :: Text
executionRoleArn = Text
pExecutionRoleArn_,
        $sel:creationTime:DescribeModelResponse' :: POSIX
creationTime = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pCreationTime_,
        $sel:modelArn:DescribeModelResponse' :: Text
modelArn = Text
pModelArn_
      }

-- | The containers in the inference pipeline.
describeModelResponse_containers :: Lens.Lens' DescribeModelResponse (Prelude.Maybe [ContainerDefinition])
describeModelResponse_containers :: Lens' DescribeModelResponse (Maybe [ContainerDefinition])
describeModelResponse_containers = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeModelResponse' {Maybe [ContainerDefinition]
containers :: Maybe [ContainerDefinition]
$sel:containers:DescribeModelResponse' :: DescribeModelResponse -> Maybe [ContainerDefinition]
containers} -> Maybe [ContainerDefinition]
containers) (\s :: DescribeModelResponse
s@DescribeModelResponse' {} Maybe [ContainerDefinition]
a -> DescribeModelResponse
s {$sel:containers:DescribeModelResponse' :: Maybe [ContainerDefinition]
containers = Maybe [ContainerDefinition]
a} :: DescribeModelResponse) 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

-- | If @True@, no inbound or outbound network calls can be made to or from
-- the model container.
describeModelResponse_enableNetworkIsolation :: Lens.Lens' DescribeModelResponse (Prelude.Maybe Prelude.Bool)
describeModelResponse_enableNetworkIsolation :: Lens' DescribeModelResponse (Maybe Bool)
describeModelResponse_enableNetworkIsolation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeModelResponse' {Maybe Bool
enableNetworkIsolation :: Maybe Bool
$sel:enableNetworkIsolation:DescribeModelResponse' :: DescribeModelResponse -> Maybe Bool
enableNetworkIsolation} -> Maybe Bool
enableNetworkIsolation) (\s :: DescribeModelResponse
s@DescribeModelResponse' {} Maybe Bool
a -> DescribeModelResponse
s {$sel:enableNetworkIsolation:DescribeModelResponse' :: Maybe Bool
enableNetworkIsolation = Maybe Bool
a} :: DescribeModelResponse)

-- | Specifies details of how containers in a multi-container endpoint are
-- called.
describeModelResponse_inferenceExecutionConfig :: Lens.Lens' DescribeModelResponse (Prelude.Maybe InferenceExecutionConfig)
describeModelResponse_inferenceExecutionConfig :: Lens' DescribeModelResponse (Maybe InferenceExecutionConfig)
describeModelResponse_inferenceExecutionConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeModelResponse' {Maybe InferenceExecutionConfig
inferenceExecutionConfig :: Maybe InferenceExecutionConfig
$sel:inferenceExecutionConfig:DescribeModelResponse' :: DescribeModelResponse -> Maybe InferenceExecutionConfig
inferenceExecutionConfig} -> Maybe InferenceExecutionConfig
inferenceExecutionConfig) (\s :: DescribeModelResponse
s@DescribeModelResponse' {} Maybe InferenceExecutionConfig
a -> DescribeModelResponse
s {$sel:inferenceExecutionConfig:DescribeModelResponse' :: Maybe InferenceExecutionConfig
inferenceExecutionConfig = Maybe InferenceExecutionConfig
a} :: DescribeModelResponse)

-- | The location of the primary inference code, associated artifacts, and
-- custom environment map that the inference code uses when it is deployed
-- in production.
describeModelResponse_primaryContainer :: Lens.Lens' DescribeModelResponse (Prelude.Maybe ContainerDefinition)
describeModelResponse_primaryContainer :: Lens' DescribeModelResponse (Maybe ContainerDefinition)
describeModelResponse_primaryContainer = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeModelResponse' {Maybe ContainerDefinition
primaryContainer :: Maybe ContainerDefinition
$sel:primaryContainer:DescribeModelResponse' :: DescribeModelResponse -> Maybe ContainerDefinition
primaryContainer} -> Maybe ContainerDefinition
primaryContainer) (\s :: DescribeModelResponse
s@DescribeModelResponse' {} Maybe ContainerDefinition
a -> DescribeModelResponse
s {$sel:primaryContainer:DescribeModelResponse' :: Maybe ContainerDefinition
primaryContainer = Maybe ContainerDefinition
a} :: DescribeModelResponse)

-- | A VpcConfig object that specifies the VPC that this model has access to.
-- For more information, see
-- <https://docs.aws.amazon.com/sagemaker/latest/dg/host-vpc.html Protect Endpoints by Using an Amazon Virtual Private Cloud>
describeModelResponse_vpcConfig :: Lens.Lens' DescribeModelResponse (Prelude.Maybe VpcConfig)
describeModelResponse_vpcConfig :: Lens' DescribeModelResponse (Maybe VpcConfig)
describeModelResponse_vpcConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeModelResponse' {Maybe VpcConfig
vpcConfig :: Maybe VpcConfig
$sel:vpcConfig:DescribeModelResponse' :: DescribeModelResponse -> Maybe VpcConfig
vpcConfig} -> Maybe VpcConfig
vpcConfig) (\s :: DescribeModelResponse
s@DescribeModelResponse' {} Maybe VpcConfig
a -> DescribeModelResponse
s {$sel:vpcConfig:DescribeModelResponse' :: Maybe VpcConfig
vpcConfig = Maybe VpcConfig
a} :: DescribeModelResponse)

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

-- | Name of the SageMaker model.
describeModelResponse_modelName :: Lens.Lens' DescribeModelResponse Prelude.Text
describeModelResponse_modelName :: Lens' DescribeModelResponse Text
describeModelResponse_modelName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeModelResponse' {Text
modelName :: Text
$sel:modelName:DescribeModelResponse' :: DescribeModelResponse -> Text
modelName} -> Text
modelName) (\s :: DescribeModelResponse
s@DescribeModelResponse' {} Text
a -> DescribeModelResponse
s {$sel:modelName:DescribeModelResponse' :: Text
modelName = Text
a} :: DescribeModelResponse)

-- | The Amazon Resource Name (ARN) of the IAM role that you specified for
-- the model.
describeModelResponse_executionRoleArn :: Lens.Lens' DescribeModelResponse Prelude.Text
describeModelResponse_executionRoleArn :: Lens' DescribeModelResponse Text
describeModelResponse_executionRoleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeModelResponse' {Text
executionRoleArn :: Text
$sel:executionRoleArn:DescribeModelResponse' :: DescribeModelResponse -> Text
executionRoleArn} -> Text
executionRoleArn) (\s :: DescribeModelResponse
s@DescribeModelResponse' {} Text
a -> DescribeModelResponse
s {$sel:executionRoleArn:DescribeModelResponse' :: Text
executionRoleArn = Text
a} :: DescribeModelResponse)

-- | A timestamp that shows when the model was created.
describeModelResponse_creationTime :: Lens.Lens' DescribeModelResponse Prelude.UTCTime
describeModelResponse_creationTime :: Lens' DescribeModelResponse UTCTime
describeModelResponse_creationTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeModelResponse' {POSIX
creationTime :: POSIX
$sel:creationTime:DescribeModelResponse' :: DescribeModelResponse -> POSIX
creationTime} -> POSIX
creationTime) (\s :: DescribeModelResponse
s@DescribeModelResponse' {} POSIX
a -> DescribeModelResponse
s {$sel:creationTime:DescribeModelResponse' :: POSIX
creationTime = POSIX
a} :: DescribeModelResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The Amazon Resource Name (ARN) of the model.
describeModelResponse_modelArn :: Lens.Lens' DescribeModelResponse Prelude.Text
describeModelResponse_modelArn :: Lens' DescribeModelResponse Text
describeModelResponse_modelArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeModelResponse' {Text
modelArn :: Text
$sel:modelArn:DescribeModelResponse' :: DescribeModelResponse -> Text
modelArn} -> Text
modelArn) (\s :: DescribeModelResponse
s@DescribeModelResponse' {} Text
a -> DescribeModelResponse
s {$sel:modelArn:DescribeModelResponse' :: Text
modelArn = Text
a} :: DescribeModelResponse)

instance Prelude.NFData DescribeModelResponse where
  rnf :: DescribeModelResponse -> ()
rnf DescribeModelResponse' {Int
Maybe Bool
Maybe [ContainerDefinition]
Maybe InferenceExecutionConfig
Maybe ContainerDefinition
Maybe VpcConfig
Text
POSIX
modelArn :: Text
creationTime :: POSIX
executionRoleArn :: Text
modelName :: Text
httpStatus :: Int
vpcConfig :: Maybe VpcConfig
primaryContainer :: Maybe ContainerDefinition
inferenceExecutionConfig :: Maybe InferenceExecutionConfig
enableNetworkIsolation :: Maybe Bool
containers :: Maybe [ContainerDefinition]
$sel:modelArn:DescribeModelResponse' :: DescribeModelResponse -> Text
$sel:creationTime:DescribeModelResponse' :: DescribeModelResponse -> POSIX
$sel:executionRoleArn:DescribeModelResponse' :: DescribeModelResponse -> Text
$sel:modelName:DescribeModelResponse' :: DescribeModelResponse -> Text
$sel:httpStatus:DescribeModelResponse' :: DescribeModelResponse -> Int
$sel:vpcConfig:DescribeModelResponse' :: DescribeModelResponse -> Maybe VpcConfig
$sel:primaryContainer:DescribeModelResponse' :: DescribeModelResponse -> Maybe ContainerDefinition
$sel:inferenceExecutionConfig:DescribeModelResponse' :: DescribeModelResponse -> Maybe InferenceExecutionConfig
$sel:enableNetworkIsolation:DescribeModelResponse' :: DescribeModelResponse -> Maybe Bool
$sel:containers:DescribeModelResponse' :: DescribeModelResponse -> Maybe [ContainerDefinition]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [ContainerDefinition]
containers
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
enableNetworkIsolation
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe InferenceExecutionConfig
inferenceExecutionConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ContainerDefinition
primaryContainer
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe VpcConfig
vpcConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
modelName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
executionRoleArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
creationTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
modelArn