{-# 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.IoTFleetWise.GetModelManifest
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves information about a vehicle model (model manifest).
module Amazonka.IoTFleetWise.GetModelManifest
  ( -- * Creating a Request
    GetModelManifest (..),
    newGetModelManifest,

    -- * Request Lenses
    getModelManifest_name,

    -- * Destructuring the Response
    GetModelManifestResponse (..),
    newGetModelManifestResponse,

    -- * Response Lenses
    getModelManifestResponse_description,
    getModelManifestResponse_signalCatalogArn,
    getModelManifestResponse_status,
    getModelManifestResponse_httpStatus,
    getModelManifestResponse_name,
    getModelManifestResponse_arn,
    getModelManifestResponse_creationTime,
    getModelManifestResponse_lastModificationTime,
  )
where

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

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

-- |
-- Create a value of 'GetModelManifest' 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:
--
-- 'name', 'getModelManifest_name' - The name of the vehicle model to retrieve information about.
newGetModelManifest ::
  -- | 'name'
  Prelude.Text ->
  GetModelManifest
newGetModelManifest :: Text -> GetModelManifest
newGetModelManifest Text
pName_ =
  GetModelManifest' {$sel:name:GetModelManifest' :: Text
name = Text
pName_}

-- | The name of the vehicle model to retrieve information about.
getModelManifest_name :: Lens.Lens' GetModelManifest Prelude.Text
getModelManifest_name :: Lens' GetModelManifest Text
getModelManifest_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetModelManifest' {Text
name :: Text
$sel:name:GetModelManifest' :: GetModelManifest -> Text
name} -> Text
name) (\s :: GetModelManifest
s@GetModelManifest' {} Text
a -> GetModelManifest
s {$sel:name:GetModelManifest' :: Text
name = Text
a} :: GetModelManifest)

instance Core.AWSRequest GetModelManifest where
  type
    AWSResponse GetModelManifest =
      GetModelManifestResponse
  request :: (Service -> Service)
-> GetModelManifest -> Request GetModelManifest
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 GetModelManifest
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetModelManifest)))
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
-> Maybe Text
-> Maybe ManifestStatus
-> Int
-> Text
-> Text
-> POSIX
-> POSIX
-> GetModelManifestResponse
GetModelManifestResponse'
            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
"description")
            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
"signalCatalogArn")
            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
"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))
            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
"name")
            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
"arn")
            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
"lastModificationTime")
      )

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

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

instance Data.ToHeaders GetModelManifest where
  toHeaders :: GetModelManifest -> 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
"IoTAutobahnControlPlane.GetModelManifest" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.0" ::
                          Prelude.ByteString
                      )
          ]
      )

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

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

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

-- | /See:/ 'newGetModelManifestResponse' smart constructor.
data GetModelManifestResponse = GetModelManifestResponse'
  { -- | A brief description of the vehicle model.
    GetModelManifestResponse -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The ARN of the signal catalog associated with the vehicle model.
    GetModelManifestResponse -> Maybe Text
signalCatalogArn :: Prelude.Maybe Prelude.Text,
    -- | The state of the vehicle model. If the status is @ACTIVE@, the vehicle
    -- model can\'t be edited. You can edit the vehicle model if the status is
    -- marked @DRAFT@.
    GetModelManifestResponse -> Maybe ManifestStatus
status :: Prelude.Maybe ManifestStatus,
    -- | The response's http status code.
    GetModelManifestResponse -> Int
httpStatus :: Prelude.Int,
    -- | The name of the vehicle model.
    GetModelManifestResponse -> Text
name :: Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the vehicle model.
    GetModelManifestResponse -> Text
arn :: Prelude.Text,
    -- | The time the vehicle model was created, in seconds since epoch (January
    -- 1, 1970 at midnight UTC time).
    GetModelManifestResponse -> POSIX
creationTime :: Data.POSIX,
    -- | The last time the vehicle model was modified.
    GetModelManifestResponse -> POSIX
lastModificationTime :: Data.POSIX
  }
  deriving (GetModelManifestResponse -> GetModelManifestResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetModelManifestResponse -> GetModelManifestResponse -> Bool
$c/= :: GetModelManifestResponse -> GetModelManifestResponse -> Bool
== :: GetModelManifestResponse -> GetModelManifestResponse -> Bool
$c== :: GetModelManifestResponse -> GetModelManifestResponse -> Bool
Prelude.Eq, ReadPrec [GetModelManifestResponse]
ReadPrec GetModelManifestResponse
Int -> ReadS GetModelManifestResponse
ReadS [GetModelManifestResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetModelManifestResponse]
$creadListPrec :: ReadPrec [GetModelManifestResponse]
readPrec :: ReadPrec GetModelManifestResponse
$creadPrec :: ReadPrec GetModelManifestResponse
readList :: ReadS [GetModelManifestResponse]
$creadList :: ReadS [GetModelManifestResponse]
readsPrec :: Int -> ReadS GetModelManifestResponse
$creadsPrec :: Int -> ReadS GetModelManifestResponse
Prelude.Read, Int -> GetModelManifestResponse -> ShowS
[GetModelManifestResponse] -> ShowS
GetModelManifestResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetModelManifestResponse] -> ShowS
$cshowList :: [GetModelManifestResponse] -> ShowS
show :: GetModelManifestResponse -> String
$cshow :: GetModelManifestResponse -> String
showsPrec :: Int -> GetModelManifestResponse -> ShowS
$cshowsPrec :: Int -> GetModelManifestResponse -> ShowS
Prelude.Show, forall x.
Rep GetModelManifestResponse x -> GetModelManifestResponse
forall x.
GetModelManifestResponse -> Rep GetModelManifestResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetModelManifestResponse x -> GetModelManifestResponse
$cfrom :: forall x.
GetModelManifestResponse -> Rep GetModelManifestResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetModelManifestResponse' 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:
--
-- 'description', 'getModelManifestResponse_description' - A brief description of the vehicle model.
--
-- 'signalCatalogArn', 'getModelManifestResponse_signalCatalogArn' - The ARN of the signal catalog associated with the vehicle model.
--
-- 'status', 'getModelManifestResponse_status' - The state of the vehicle model. If the status is @ACTIVE@, the vehicle
-- model can\'t be edited. You can edit the vehicle model if the status is
-- marked @DRAFT@.
--
-- 'httpStatus', 'getModelManifestResponse_httpStatus' - The response's http status code.
--
-- 'name', 'getModelManifestResponse_name' - The name of the vehicle model.
--
-- 'arn', 'getModelManifestResponse_arn' - The Amazon Resource Name (ARN) of the vehicle model.
--
-- 'creationTime', 'getModelManifestResponse_creationTime' - The time the vehicle model was created, in seconds since epoch (January
-- 1, 1970 at midnight UTC time).
--
-- 'lastModificationTime', 'getModelManifestResponse_lastModificationTime' - The last time the vehicle model was modified.
newGetModelManifestResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'name'
  Prelude.Text ->
  -- | 'arn'
  Prelude.Text ->
  -- | 'creationTime'
  Prelude.UTCTime ->
  -- | 'lastModificationTime'
  Prelude.UTCTime ->
  GetModelManifestResponse
newGetModelManifestResponse :: Int
-> Text -> Text -> UTCTime -> UTCTime -> GetModelManifestResponse
newGetModelManifestResponse
  Int
pHttpStatus_
  Text
pName_
  Text
pArn_
  UTCTime
pCreationTime_
  UTCTime
pLastModificationTime_ =
    GetModelManifestResponse'
      { $sel:description:GetModelManifestResponse' :: Maybe Text
description =
          forall a. Maybe a
Prelude.Nothing,
        $sel:signalCatalogArn:GetModelManifestResponse' :: Maybe Text
signalCatalogArn = forall a. Maybe a
Prelude.Nothing,
        $sel:status:GetModelManifestResponse' :: Maybe ManifestStatus
status = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:GetModelManifestResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:name:GetModelManifestResponse' :: Text
name = Text
pName_,
        $sel:arn:GetModelManifestResponse' :: Text
arn = Text
pArn_,
        $sel:creationTime:GetModelManifestResponse' :: POSIX
creationTime = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pCreationTime_,
        $sel:lastModificationTime:GetModelManifestResponse' :: POSIX
lastModificationTime =
          forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pLastModificationTime_
      }

-- | A brief description of the vehicle model.
getModelManifestResponse_description :: Lens.Lens' GetModelManifestResponse (Prelude.Maybe Prelude.Text)
getModelManifestResponse_description :: Lens' GetModelManifestResponse (Maybe Text)
getModelManifestResponse_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetModelManifestResponse' {Maybe Text
description :: Maybe Text
$sel:description:GetModelManifestResponse' :: GetModelManifestResponse -> Maybe Text
description} -> Maybe Text
description) (\s :: GetModelManifestResponse
s@GetModelManifestResponse' {} Maybe Text
a -> GetModelManifestResponse
s {$sel:description:GetModelManifestResponse' :: Maybe Text
description = Maybe Text
a} :: GetModelManifestResponse)

-- | The ARN of the signal catalog associated with the vehicle model.
getModelManifestResponse_signalCatalogArn :: Lens.Lens' GetModelManifestResponse (Prelude.Maybe Prelude.Text)
getModelManifestResponse_signalCatalogArn :: Lens' GetModelManifestResponse (Maybe Text)
getModelManifestResponse_signalCatalogArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetModelManifestResponse' {Maybe Text
signalCatalogArn :: Maybe Text
$sel:signalCatalogArn:GetModelManifestResponse' :: GetModelManifestResponse -> Maybe Text
signalCatalogArn} -> Maybe Text
signalCatalogArn) (\s :: GetModelManifestResponse
s@GetModelManifestResponse' {} Maybe Text
a -> GetModelManifestResponse
s {$sel:signalCatalogArn:GetModelManifestResponse' :: Maybe Text
signalCatalogArn = Maybe Text
a} :: GetModelManifestResponse)

-- | The state of the vehicle model. If the status is @ACTIVE@, the vehicle
-- model can\'t be edited. You can edit the vehicle model if the status is
-- marked @DRAFT@.
getModelManifestResponse_status :: Lens.Lens' GetModelManifestResponse (Prelude.Maybe ManifestStatus)
getModelManifestResponse_status :: Lens' GetModelManifestResponse (Maybe ManifestStatus)
getModelManifestResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetModelManifestResponse' {Maybe ManifestStatus
status :: Maybe ManifestStatus
$sel:status:GetModelManifestResponse' :: GetModelManifestResponse -> Maybe ManifestStatus
status} -> Maybe ManifestStatus
status) (\s :: GetModelManifestResponse
s@GetModelManifestResponse' {} Maybe ManifestStatus
a -> GetModelManifestResponse
s {$sel:status:GetModelManifestResponse' :: Maybe ManifestStatus
status = Maybe ManifestStatus
a} :: GetModelManifestResponse)

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

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

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

-- | The time the vehicle model was created, in seconds since epoch (January
-- 1, 1970 at midnight UTC time).
getModelManifestResponse_creationTime :: Lens.Lens' GetModelManifestResponse Prelude.UTCTime
getModelManifestResponse_creationTime :: Lens' GetModelManifestResponse UTCTime
getModelManifestResponse_creationTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetModelManifestResponse' {POSIX
creationTime :: POSIX
$sel:creationTime:GetModelManifestResponse' :: GetModelManifestResponse -> POSIX
creationTime} -> POSIX
creationTime) (\s :: GetModelManifestResponse
s@GetModelManifestResponse' {} POSIX
a -> GetModelManifestResponse
s {$sel:creationTime:GetModelManifestResponse' :: POSIX
creationTime = POSIX
a} :: GetModelManifestResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The last time the vehicle model was modified.
getModelManifestResponse_lastModificationTime :: Lens.Lens' GetModelManifestResponse Prelude.UTCTime
getModelManifestResponse_lastModificationTime :: Lens' GetModelManifestResponse UTCTime
getModelManifestResponse_lastModificationTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetModelManifestResponse' {POSIX
lastModificationTime :: POSIX
$sel:lastModificationTime:GetModelManifestResponse' :: GetModelManifestResponse -> POSIX
lastModificationTime} -> POSIX
lastModificationTime) (\s :: GetModelManifestResponse
s@GetModelManifestResponse' {} POSIX
a -> GetModelManifestResponse
s {$sel:lastModificationTime:GetModelManifestResponse' :: POSIX
lastModificationTime = POSIX
a} :: GetModelManifestResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

instance Prelude.NFData GetModelManifestResponse where
  rnf :: GetModelManifestResponse -> ()
rnf GetModelManifestResponse' {Int
Maybe Text
Maybe ManifestStatus
Text
POSIX
lastModificationTime :: POSIX
creationTime :: POSIX
arn :: Text
name :: Text
httpStatus :: Int
status :: Maybe ManifestStatus
signalCatalogArn :: Maybe Text
description :: Maybe Text
$sel:lastModificationTime:GetModelManifestResponse' :: GetModelManifestResponse -> POSIX
$sel:creationTime:GetModelManifestResponse' :: GetModelManifestResponse -> POSIX
$sel:arn:GetModelManifestResponse' :: GetModelManifestResponse -> Text
$sel:name:GetModelManifestResponse' :: GetModelManifestResponse -> Text
$sel:httpStatus:GetModelManifestResponse' :: GetModelManifestResponse -> Int
$sel:status:GetModelManifestResponse' :: GetModelManifestResponse -> Maybe ManifestStatus
$sel:signalCatalogArn:GetModelManifestResponse' :: GetModelManifestResponse -> Maybe Text
$sel:description:GetModelManifestResponse' :: GetModelManifestResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
signalCatalogArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ManifestStatus
status
      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
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
arn
      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 POSIX
lastModificationTime