{-# 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.GetVehicle
-- 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.
module Amazonka.IoTFleetWise.GetVehicle
  ( -- * Creating a Request
    GetVehicle (..),
    newGetVehicle,

    -- * Request Lenses
    getVehicle_vehicleName,

    -- * Destructuring the Response
    GetVehicleResponse (..),
    newGetVehicleResponse,

    -- * Response Lenses
    getVehicleResponse_arn,
    getVehicleResponse_attributes,
    getVehicleResponse_creationTime,
    getVehicleResponse_decoderManifestArn,
    getVehicleResponse_lastModificationTime,
    getVehicleResponse_modelManifestArn,
    getVehicleResponse_vehicleName,
    getVehicleResponse_httpStatus,
  )
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:/ 'newGetVehicle' smart constructor.
data GetVehicle = GetVehicle'
  { -- | The ID of the vehicle to retrieve information about.
    GetVehicle -> Text
vehicleName :: Prelude.Text
  }
  deriving (GetVehicle -> GetVehicle -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetVehicle -> GetVehicle -> Bool
$c/= :: GetVehicle -> GetVehicle -> Bool
== :: GetVehicle -> GetVehicle -> Bool
$c== :: GetVehicle -> GetVehicle -> Bool
Prelude.Eq, ReadPrec [GetVehicle]
ReadPrec GetVehicle
Int -> ReadS GetVehicle
ReadS [GetVehicle]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetVehicle]
$creadListPrec :: ReadPrec [GetVehicle]
readPrec :: ReadPrec GetVehicle
$creadPrec :: ReadPrec GetVehicle
readList :: ReadS [GetVehicle]
$creadList :: ReadS [GetVehicle]
readsPrec :: Int -> ReadS GetVehicle
$creadsPrec :: Int -> ReadS GetVehicle
Prelude.Read, Int -> GetVehicle -> ShowS
[GetVehicle] -> ShowS
GetVehicle -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetVehicle] -> ShowS
$cshowList :: [GetVehicle] -> ShowS
show :: GetVehicle -> String
$cshow :: GetVehicle -> String
showsPrec :: Int -> GetVehicle -> ShowS
$cshowsPrec :: Int -> GetVehicle -> ShowS
Prelude.Show, forall x. Rep GetVehicle x -> GetVehicle
forall x. GetVehicle -> Rep GetVehicle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetVehicle x -> GetVehicle
$cfrom :: forall x. GetVehicle -> Rep GetVehicle x
Prelude.Generic)

-- |
-- Create a value of 'GetVehicle' 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:
--
-- 'vehicleName', 'getVehicle_vehicleName' - The ID of the vehicle to retrieve information about.
newGetVehicle ::
  -- | 'vehicleName'
  Prelude.Text ->
  GetVehicle
newGetVehicle :: Text -> GetVehicle
newGetVehicle Text
pVehicleName_ =
  GetVehicle' {$sel:vehicleName:GetVehicle' :: Text
vehicleName = Text
pVehicleName_}

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

instance Core.AWSRequest GetVehicle where
  type AWSResponse GetVehicle = GetVehicleResponse
  request :: (Service -> Service) -> GetVehicle -> Request GetVehicle
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 GetVehicle
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetVehicle)))
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 (HashMap Text Text)
-> Maybe POSIX
-> Maybe Text
-> Maybe POSIX
-> Maybe Text
-> Maybe Text
-> Int
-> GetVehicleResponse
GetVehicleResponse'
            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
"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 (Maybe a)
Data..?> Key
"attributes" 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
"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 (Maybe a)
Data..?> Key
"decoderManifestArn")
            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
"lastModificationTime")
            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
"modelManifestArn")
            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
"vehicleName")
            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 GetVehicle where
  hashWithSalt :: Int -> GetVehicle -> Int
hashWithSalt Int
_salt GetVehicle' {Text
vehicleName :: Text
$sel:vehicleName:GetVehicle' :: GetVehicle -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
vehicleName

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

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

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

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

-- | /See:/ 'newGetVehicleResponse' smart constructor.
data GetVehicleResponse = GetVehicleResponse'
  { -- | The Amazon Resource Name (ARN) of the vehicle to retrieve information
    -- about.
    GetVehicleResponse -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    -- | Static information about a vehicle in a key-value pair. For example:
    --
    -- @\"engineType\"@ : @\"1.3 L R2\"@
    GetVehicleResponse -> Maybe (HashMap Text Text)
attributes :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The time the vehicle was created in seconds since epoch (January 1, 1970
    -- at midnight UTC time).
    GetVehicleResponse -> Maybe POSIX
creationTime :: Prelude.Maybe Data.POSIX,
    -- | The ARN of a decoder manifest associated with the vehicle.
    GetVehicleResponse -> Maybe Text
decoderManifestArn :: Prelude.Maybe Prelude.Text,
    -- | The time the vehicle was last updated in seconds since epoch (January 1,
    -- 1970 at midnight UTC time).
    GetVehicleResponse -> Maybe POSIX
lastModificationTime :: Prelude.Maybe Data.POSIX,
    -- | The ARN of a vehicle model (model manifest) associated with the vehicle.
    GetVehicleResponse -> Maybe Text
modelManifestArn :: Prelude.Maybe Prelude.Text,
    -- | The ID of the vehicle.
    GetVehicleResponse -> Maybe Text
vehicleName :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetVehicleResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetVehicleResponse -> GetVehicleResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetVehicleResponse -> GetVehicleResponse -> Bool
$c/= :: GetVehicleResponse -> GetVehicleResponse -> Bool
== :: GetVehicleResponse -> GetVehicleResponse -> Bool
$c== :: GetVehicleResponse -> GetVehicleResponse -> Bool
Prelude.Eq, ReadPrec [GetVehicleResponse]
ReadPrec GetVehicleResponse
Int -> ReadS GetVehicleResponse
ReadS [GetVehicleResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetVehicleResponse]
$creadListPrec :: ReadPrec [GetVehicleResponse]
readPrec :: ReadPrec GetVehicleResponse
$creadPrec :: ReadPrec GetVehicleResponse
readList :: ReadS [GetVehicleResponse]
$creadList :: ReadS [GetVehicleResponse]
readsPrec :: Int -> ReadS GetVehicleResponse
$creadsPrec :: Int -> ReadS GetVehicleResponse
Prelude.Read, Int -> GetVehicleResponse -> ShowS
[GetVehicleResponse] -> ShowS
GetVehicleResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetVehicleResponse] -> ShowS
$cshowList :: [GetVehicleResponse] -> ShowS
show :: GetVehicleResponse -> String
$cshow :: GetVehicleResponse -> String
showsPrec :: Int -> GetVehicleResponse -> ShowS
$cshowsPrec :: Int -> GetVehicleResponse -> ShowS
Prelude.Show, forall x. Rep GetVehicleResponse x -> GetVehicleResponse
forall x. GetVehicleResponse -> Rep GetVehicleResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetVehicleResponse x -> GetVehicleResponse
$cfrom :: forall x. GetVehicleResponse -> Rep GetVehicleResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetVehicleResponse' 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:
--
-- 'arn', 'getVehicleResponse_arn' - The Amazon Resource Name (ARN) of the vehicle to retrieve information
-- about.
--
-- 'attributes', 'getVehicleResponse_attributes' - Static information about a vehicle in a key-value pair. For example:
--
-- @\"engineType\"@ : @\"1.3 L R2\"@
--
-- 'creationTime', 'getVehicleResponse_creationTime' - The time the vehicle was created in seconds since epoch (January 1, 1970
-- at midnight UTC time).
--
-- 'decoderManifestArn', 'getVehicleResponse_decoderManifestArn' - The ARN of a decoder manifest associated with the vehicle.
--
-- 'lastModificationTime', 'getVehicleResponse_lastModificationTime' - The time the vehicle was last updated in seconds since epoch (January 1,
-- 1970 at midnight UTC time).
--
-- 'modelManifestArn', 'getVehicleResponse_modelManifestArn' - The ARN of a vehicle model (model manifest) associated with the vehicle.
--
-- 'vehicleName', 'getVehicleResponse_vehicleName' - The ID of the vehicle.
--
-- 'httpStatus', 'getVehicleResponse_httpStatus' - The response's http status code.
newGetVehicleResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetVehicleResponse
newGetVehicleResponse :: Int -> GetVehicleResponse
newGetVehicleResponse Int
pHttpStatus_ =
  GetVehicleResponse'
    { $sel:arn:GetVehicleResponse' :: Maybe Text
arn = forall a. Maybe a
Prelude.Nothing,
      $sel:attributes:GetVehicleResponse' :: Maybe (HashMap Text Text)
attributes = forall a. Maybe a
Prelude.Nothing,
      $sel:creationTime:GetVehicleResponse' :: Maybe POSIX
creationTime = forall a. Maybe a
Prelude.Nothing,
      $sel:decoderManifestArn:GetVehicleResponse' :: Maybe Text
decoderManifestArn = forall a. Maybe a
Prelude.Nothing,
      $sel:lastModificationTime:GetVehicleResponse' :: Maybe POSIX
lastModificationTime = forall a. Maybe a
Prelude.Nothing,
      $sel:modelManifestArn:GetVehicleResponse' :: Maybe Text
modelManifestArn = forall a. Maybe a
Prelude.Nothing,
      $sel:vehicleName:GetVehicleResponse' :: Maybe Text
vehicleName = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetVehicleResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name (ARN) of the vehicle to retrieve information
-- about.
getVehicleResponse_arn :: Lens.Lens' GetVehicleResponse (Prelude.Maybe Prelude.Text)
getVehicleResponse_arn :: Lens' GetVehicleResponse (Maybe Text)
getVehicleResponse_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetVehicleResponse' {Maybe Text
arn :: Maybe Text
$sel:arn:GetVehicleResponse' :: GetVehicleResponse -> Maybe Text
arn} -> Maybe Text
arn) (\s :: GetVehicleResponse
s@GetVehicleResponse' {} Maybe Text
a -> GetVehicleResponse
s {$sel:arn:GetVehicleResponse' :: Maybe Text
arn = Maybe Text
a} :: GetVehicleResponse)

-- | Static information about a vehicle in a key-value pair. For example:
--
-- @\"engineType\"@ : @\"1.3 L R2\"@
getVehicleResponse_attributes :: Lens.Lens' GetVehicleResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
getVehicleResponse_attributes :: Lens' GetVehicleResponse (Maybe (HashMap Text Text))
getVehicleResponse_attributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetVehicleResponse' {Maybe (HashMap Text Text)
attributes :: Maybe (HashMap Text Text)
$sel:attributes:GetVehicleResponse' :: GetVehicleResponse -> Maybe (HashMap Text Text)
attributes} -> Maybe (HashMap Text Text)
attributes) (\s :: GetVehicleResponse
s@GetVehicleResponse' {} Maybe (HashMap Text Text)
a -> GetVehicleResponse
s {$sel:attributes:GetVehicleResponse' :: Maybe (HashMap Text Text)
attributes = Maybe (HashMap Text Text)
a} :: GetVehicleResponse) 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

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

-- | The ARN of a decoder manifest associated with the vehicle.
getVehicleResponse_decoderManifestArn :: Lens.Lens' GetVehicleResponse (Prelude.Maybe Prelude.Text)
getVehicleResponse_decoderManifestArn :: Lens' GetVehicleResponse (Maybe Text)
getVehicleResponse_decoderManifestArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetVehicleResponse' {Maybe Text
decoderManifestArn :: Maybe Text
$sel:decoderManifestArn:GetVehicleResponse' :: GetVehicleResponse -> Maybe Text
decoderManifestArn} -> Maybe Text
decoderManifestArn) (\s :: GetVehicleResponse
s@GetVehicleResponse' {} Maybe Text
a -> GetVehicleResponse
s {$sel:decoderManifestArn:GetVehicleResponse' :: Maybe Text
decoderManifestArn = Maybe Text
a} :: GetVehicleResponse)

-- | The time the vehicle was last updated in seconds since epoch (January 1,
-- 1970 at midnight UTC time).
getVehicleResponse_lastModificationTime :: Lens.Lens' GetVehicleResponse (Prelude.Maybe Prelude.UTCTime)
getVehicleResponse_lastModificationTime :: Lens' GetVehicleResponse (Maybe UTCTime)
getVehicleResponse_lastModificationTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetVehicleResponse' {Maybe POSIX
lastModificationTime :: Maybe POSIX
$sel:lastModificationTime:GetVehicleResponse' :: GetVehicleResponse -> Maybe POSIX
lastModificationTime} -> Maybe POSIX
lastModificationTime) (\s :: GetVehicleResponse
s@GetVehicleResponse' {} Maybe POSIX
a -> GetVehicleResponse
s {$sel:lastModificationTime:GetVehicleResponse' :: Maybe POSIX
lastModificationTime = Maybe POSIX
a} :: GetVehicleResponse) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The ARN of a vehicle model (model manifest) associated with the vehicle.
getVehicleResponse_modelManifestArn :: Lens.Lens' GetVehicleResponse (Prelude.Maybe Prelude.Text)
getVehicleResponse_modelManifestArn :: Lens' GetVehicleResponse (Maybe Text)
getVehicleResponse_modelManifestArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetVehicleResponse' {Maybe Text
modelManifestArn :: Maybe Text
$sel:modelManifestArn:GetVehicleResponse' :: GetVehicleResponse -> Maybe Text
modelManifestArn} -> Maybe Text
modelManifestArn) (\s :: GetVehicleResponse
s@GetVehicleResponse' {} Maybe Text
a -> GetVehicleResponse
s {$sel:modelManifestArn:GetVehicleResponse' :: Maybe Text
modelManifestArn = Maybe Text
a} :: GetVehicleResponse)

-- | The ID of the vehicle.
getVehicleResponse_vehicleName :: Lens.Lens' GetVehicleResponse (Prelude.Maybe Prelude.Text)
getVehicleResponse_vehicleName :: Lens' GetVehicleResponse (Maybe Text)
getVehicleResponse_vehicleName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetVehicleResponse' {Maybe Text
vehicleName :: Maybe Text
$sel:vehicleName:GetVehicleResponse' :: GetVehicleResponse -> Maybe Text
vehicleName} -> Maybe Text
vehicleName) (\s :: GetVehicleResponse
s@GetVehicleResponse' {} Maybe Text
a -> GetVehicleResponse
s {$sel:vehicleName:GetVehicleResponse' :: Maybe Text
vehicleName = Maybe Text
a} :: GetVehicleResponse)

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

instance Prelude.NFData GetVehicleResponse where
  rnf :: GetVehicleResponse -> ()
rnf GetVehicleResponse' {Int
Maybe Text
Maybe (HashMap Text Text)
Maybe POSIX
httpStatus :: Int
vehicleName :: Maybe Text
modelManifestArn :: Maybe Text
lastModificationTime :: Maybe POSIX
decoderManifestArn :: Maybe Text
creationTime :: Maybe POSIX
attributes :: Maybe (HashMap Text Text)
arn :: Maybe Text
$sel:httpStatus:GetVehicleResponse' :: GetVehicleResponse -> Int
$sel:vehicleName:GetVehicleResponse' :: GetVehicleResponse -> Maybe Text
$sel:modelManifestArn:GetVehicleResponse' :: GetVehicleResponse -> Maybe Text
$sel:lastModificationTime:GetVehicleResponse' :: GetVehicleResponse -> Maybe POSIX
$sel:decoderManifestArn:GetVehicleResponse' :: GetVehicleResponse -> Maybe Text
$sel:creationTime:GetVehicleResponse' :: GetVehicleResponse -> Maybe POSIX
$sel:attributes:GetVehicleResponse' :: GetVehicleResponse -> Maybe (HashMap Text Text)
$sel:arn:GetVehicleResponse' :: GetVehicleResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
arn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
attributes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
creationTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
decoderManifestArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
lastModificationTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
modelManifestArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
vehicleName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus