{-# 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.CreateDecoderManifest
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates the decoder manifest associated with a model manifest. To create
-- a decoder manifest, the following must be true:
--
-- -   Every signal decoder has a unique name.
--
-- -   Each signal decoder is associated with a network interface.
--
-- -   Each network interface has a unique ID.
--
-- -   The signal decoders are specified in the model manifest.
module Amazonka.IoTFleetWise.CreateDecoderManifest
  ( -- * Creating a Request
    CreateDecoderManifest (..),
    newCreateDecoderManifest,

    -- * Request Lenses
    createDecoderManifest_description,
    createDecoderManifest_networkInterfaces,
    createDecoderManifest_signalDecoders,
    createDecoderManifest_tags,
    createDecoderManifest_name,
    createDecoderManifest_modelManifestArn,

    -- * Destructuring the Response
    CreateDecoderManifestResponse (..),
    newCreateDecoderManifestResponse,

    -- * Response Lenses
    createDecoderManifestResponse_httpStatus,
    createDecoderManifestResponse_name,
    createDecoderManifestResponse_arn,
  )
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:/ 'newCreateDecoderManifest' smart constructor.
data CreateDecoderManifest = CreateDecoderManifest'
  { -- | A brief description of the decoder manifest.
    CreateDecoderManifest -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | A list of information about available network interfaces.
    CreateDecoderManifest -> Maybe (NonEmpty NetworkInterface)
networkInterfaces :: Prelude.Maybe (Prelude.NonEmpty NetworkInterface),
    -- | A list of information about signal decoders.
    CreateDecoderManifest -> Maybe (NonEmpty SignalDecoder)
signalDecoders :: Prelude.Maybe (Prelude.NonEmpty SignalDecoder),
    -- | Metadata that can be used to manage the decoder manifest.
    CreateDecoderManifest -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The unique name of the decoder manifest to create.
    CreateDecoderManifest -> Text
name :: Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the vehicle model (model manifest).
    CreateDecoderManifest -> Text
modelManifestArn :: Prelude.Text
  }
  deriving (CreateDecoderManifest -> CreateDecoderManifest -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateDecoderManifest -> CreateDecoderManifest -> Bool
$c/= :: CreateDecoderManifest -> CreateDecoderManifest -> Bool
== :: CreateDecoderManifest -> CreateDecoderManifest -> Bool
$c== :: CreateDecoderManifest -> CreateDecoderManifest -> Bool
Prelude.Eq, ReadPrec [CreateDecoderManifest]
ReadPrec CreateDecoderManifest
Int -> ReadS CreateDecoderManifest
ReadS [CreateDecoderManifest]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateDecoderManifest]
$creadListPrec :: ReadPrec [CreateDecoderManifest]
readPrec :: ReadPrec CreateDecoderManifest
$creadPrec :: ReadPrec CreateDecoderManifest
readList :: ReadS [CreateDecoderManifest]
$creadList :: ReadS [CreateDecoderManifest]
readsPrec :: Int -> ReadS CreateDecoderManifest
$creadsPrec :: Int -> ReadS CreateDecoderManifest
Prelude.Read, Int -> CreateDecoderManifest -> ShowS
[CreateDecoderManifest] -> ShowS
CreateDecoderManifest -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateDecoderManifest] -> ShowS
$cshowList :: [CreateDecoderManifest] -> ShowS
show :: CreateDecoderManifest -> String
$cshow :: CreateDecoderManifest -> String
showsPrec :: Int -> CreateDecoderManifest -> ShowS
$cshowsPrec :: Int -> CreateDecoderManifest -> ShowS
Prelude.Show, forall x. Rep CreateDecoderManifest x -> CreateDecoderManifest
forall x. CreateDecoderManifest -> Rep CreateDecoderManifest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateDecoderManifest x -> CreateDecoderManifest
$cfrom :: forall x. CreateDecoderManifest -> Rep CreateDecoderManifest x
Prelude.Generic)

-- |
-- Create a value of 'CreateDecoderManifest' 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', 'createDecoderManifest_description' - A brief description of the decoder manifest.
--
-- 'networkInterfaces', 'createDecoderManifest_networkInterfaces' - A list of information about available network interfaces.
--
-- 'signalDecoders', 'createDecoderManifest_signalDecoders' - A list of information about signal decoders.
--
-- 'tags', 'createDecoderManifest_tags' - Metadata that can be used to manage the decoder manifest.
--
-- 'name', 'createDecoderManifest_name' - The unique name of the decoder manifest to create.
--
-- 'modelManifestArn', 'createDecoderManifest_modelManifestArn' - The Amazon Resource Name (ARN) of the vehicle model (model manifest).
newCreateDecoderManifest ::
  -- | 'name'
  Prelude.Text ->
  -- | 'modelManifestArn'
  Prelude.Text ->
  CreateDecoderManifest
newCreateDecoderManifest :: Text -> Text -> CreateDecoderManifest
newCreateDecoderManifest Text
pName_ Text
pModelManifestArn_ =
  CreateDecoderManifest'
    { $sel:description:CreateDecoderManifest' :: Maybe Text
description =
        forall a. Maybe a
Prelude.Nothing,
      $sel:networkInterfaces:CreateDecoderManifest' :: Maybe (NonEmpty NetworkInterface)
networkInterfaces = forall a. Maybe a
Prelude.Nothing,
      $sel:signalDecoders:CreateDecoderManifest' :: Maybe (NonEmpty SignalDecoder)
signalDecoders = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateDecoderManifest' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:name:CreateDecoderManifest' :: Text
name = Text
pName_,
      $sel:modelManifestArn:CreateDecoderManifest' :: Text
modelManifestArn = Text
pModelManifestArn_
    }

-- | A brief description of the decoder manifest.
createDecoderManifest_description :: Lens.Lens' CreateDecoderManifest (Prelude.Maybe Prelude.Text)
createDecoderManifest_description :: Lens' CreateDecoderManifest (Maybe Text)
createDecoderManifest_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDecoderManifest' {Maybe Text
description :: Maybe Text
$sel:description:CreateDecoderManifest' :: CreateDecoderManifest -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateDecoderManifest
s@CreateDecoderManifest' {} Maybe Text
a -> CreateDecoderManifest
s {$sel:description:CreateDecoderManifest' :: Maybe Text
description = Maybe Text
a} :: CreateDecoderManifest)

-- | A list of information about available network interfaces.
createDecoderManifest_networkInterfaces :: Lens.Lens' CreateDecoderManifest (Prelude.Maybe (Prelude.NonEmpty NetworkInterface))
createDecoderManifest_networkInterfaces :: Lens' CreateDecoderManifest (Maybe (NonEmpty NetworkInterface))
createDecoderManifest_networkInterfaces = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDecoderManifest' {Maybe (NonEmpty NetworkInterface)
networkInterfaces :: Maybe (NonEmpty NetworkInterface)
$sel:networkInterfaces:CreateDecoderManifest' :: CreateDecoderManifest -> Maybe (NonEmpty NetworkInterface)
networkInterfaces} -> Maybe (NonEmpty NetworkInterface)
networkInterfaces) (\s :: CreateDecoderManifest
s@CreateDecoderManifest' {} Maybe (NonEmpty NetworkInterface)
a -> CreateDecoderManifest
s {$sel:networkInterfaces:CreateDecoderManifest' :: Maybe (NonEmpty NetworkInterface)
networkInterfaces = Maybe (NonEmpty NetworkInterface)
a} :: CreateDecoderManifest) 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

-- | A list of information about signal decoders.
createDecoderManifest_signalDecoders :: Lens.Lens' CreateDecoderManifest (Prelude.Maybe (Prelude.NonEmpty SignalDecoder))
createDecoderManifest_signalDecoders :: Lens' CreateDecoderManifest (Maybe (NonEmpty SignalDecoder))
createDecoderManifest_signalDecoders = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDecoderManifest' {Maybe (NonEmpty SignalDecoder)
signalDecoders :: Maybe (NonEmpty SignalDecoder)
$sel:signalDecoders:CreateDecoderManifest' :: CreateDecoderManifest -> Maybe (NonEmpty SignalDecoder)
signalDecoders} -> Maybe (NonEmpty SignalDecoder)
signalDecoders) (\s :: CreateDecoderManifest
s@CreateDecoderManifest' {} Maybe (NonEmpty SignalDecoder)
a -> CreateDecoderManifest
s {$sel:signalDecoders:CreateDecoderManifest' :: Maybe (NonEmpty SignalDecoder)
signalDecoders = Maybe (NonEmpty SignalDecoder)
a} :: CreateDecoderManifest) 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

-- | Metadata that can be used to manage the decoder manifest.
createDecoderManifest_tags :: Lens.Lens' CreateDecoderManifest (Prelude.Maybe [Tag])
createDecoderManifest_tags :: Lens' CreateDecoderManifest (Maybe [Tag])
createDecoderManifest_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDecoderManifest' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateDecoderManifest' :: CreateDecoderManifest -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateDecoderManifest
s@CreateDecoderManifest' {} Maybe [Tag]
a -> CreateDecoderManifest
s {$sel:tags:CreateDecoderManifest' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateDecoderManifest) 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 unique name of the decoder manifest to create.
createDecoderManifest_name :: Lens.Lens' CreateDecoderManifest Prelude.Text
createDecoderManifest_name :: Lens' CreateDecoderManifest Text
createDecoderManifest_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDecoderManifest' {Text
name :: Text
$sel:name:CreateDecoderManifest' :: CreateDecoderManifest -> Text
name} -> Text
name) (\s :: CreateDecoderManifest
s@CreateDecoderManifest' {} Text
a -> CreateDecoderManifest
s {$sel:name:CreateDecoderManifest' :: Text
name = Text
a} :: CreateDecoderManifest)

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

instance Core.AWSRequest CreateDecoderManifest where
  type
    AWSResponse CreateDecoderManifest =
      CreateDecoderManifestResponse
  request :: (Service -> Service)
-> CreateDecoderManifest -> Request CreateDecoderManifest
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 CreateDecoderManifest
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateDecoderManifest)))
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 ->
          Int -> Text -> Text -> CreateDecoderManifestResponse
CreateDecoderManifestResponse'
            forall (f :: * -> *) a b. Functor 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")
      )

instance Prelude.Hashable CreateDecoderManifest where
  hashWithSalt :: Int -> CreateDecoderManifest -> Int
hashWithSalt Int
_salt CreateDecoderManifest' {Maybe [Tag]
Maybe (NonEmpty NetworkInterface)
Maybe (NonEmpty SignalDecoder)
Maybe Text
Text
modelManifestArn :: Text
name :: Text
tags :: Maybe [Tag]
signalDecoders :: Maybe (NonEmpty SignalDecoder)
networkInterfaces :: Maybe (NonEmpty NetworkInterface)
description :: Maybe Text
$sel:modelManifestArn:CreateDecoderManifest' :: CreateDecoderManifest -> Text
$sel:name:CreateDecoderManifest' :: CreateDecoderManifest -> Text
$sel:tags:CreateDecoderManifest' :: CreateDecoderManifest -> Maybe [Tag]
$sel:signalDecoders:CreateDecoderManifest' :: CreateDecoderManifest -> Maybe (NonEmpty SignalDecoder)
$sel:networkInterfaces:CreateDecoderManifest' :: CreateDecoderManifest -> Maybe (NonEmpty NetworkInterface)
$sel:description:CreateDecoderManifest' :: CreateDecoderManifest -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty NetworkInterface)
networkInterfaces
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty SignalDecoder)
signalDecoders
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
modelManifestArn

instance Prelude.NFData CreateDecoderManifest where
  rnf :: CreateDecoderManifest -> ()
rnf CreateDecoderManifest' {Maybe [Tag]
Maybe (NonEmpty NetworkInterface)
Maybe (NonEmpty SignalDecoder)
Maybe Text
Text
modelManifestArn :: Text
name :: Text
tags :: Maybe [Tag]
signalDecoders :: Maybe (NonEmpty SignalDecoder)
networkInterfaces :: Maybe (NonEmpty NetworkInterface)
description :: Maybe Text
$sel:modelManifestArn:CreateDecoderManifest' :: CreateDecoderManifest -> Text
$sel:name:CreateDecoderManifest' :: CreateDecoderManifest -> Text
$sel:tags:CreateDecoderManifest' :: CreateDecoderManifest -> Maybe [Tag]
$sel:signalDecoders:CreateDecoderManifest' :: CreateDecoderManifest -> Maybe (NonEmpty SignalDecoder)
$sel:networkInterfaces:CreateDecoderManifest' :: CreateDecoderManifest -> Maybe (NonEmpty NetworkInterface)
$sel:description:CreateDecoderManifest' :: CreateDecoderManifest -> 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 (NonEmpty NetworkInterface)
networkInterfaces
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty SignalDecoder)
signalDecoders
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      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
modelManifestArn

instance Data.ToHeaders CreateDecoderManifest where
  toHeaders :: CreateDecoderManifest -> 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.CreateDecoderManifest" ::
                          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 CreateDecoderManifest where
  toJSON :: CreateDecoderManifest -> Value
toJSON CreateDecoderManifest' {Maybe [Tag]
Maybe (NonEmpty NetworkInterface)
Maybe (NonEmpty SignalDecoder)
Maybe Text
Text
modelManifestArn :: Text
name :: Text
tags :: Maybe [Tag]
signalDecoders :: Maybe (NonEmpty SignalDecoder)
networkInterfaces :: Maybe (NonEmpty NetworkInterface)
description :: Maybe Text
$sel:modelManifestArn:CreateDecoderManifest' :: CreateDecoderManifest -> Text
$sel:name:CreateDecoderManifest' :: CreateDecoderManifest -> Text
$sel:tags:CreateDecoderManifest' :: CreateDecoderManifest -> Maybe [Tag]
$sel:signalDecoders:CreateDecoderManifest' :: CreateDecoderManifest -> Maybe (NonEmpty SignalDecoder)
$sel:networkInterfaces:CreateDecoderManifest' :: CreateDecoderManifest -> Maybe (NonEmpty NetworkInterface)
$sel:description:CreateDecoderManifest' :: CreateDecoderManifest -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"description" 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 Text
description,
            (Key
"networkInterfaces" 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 (NonEmpty NetworkInterface)
networkInterfaces,
            (Key
"signalDecoders" 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 (NonEmpty SignalDecoder)
signalDecoders,
            (Key
"tags" 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 [Tag]
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"modelManifestArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
modelManifestArn)
          ]
      )

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

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

-- | /See:/ 'newCreateDecoderManifestResponse' smart constructor.
data CreateDecoderManifestResponse = CreateDecoderManifestResponse'
  { -- | The response's http status code.
    CreateDecoderManifestResponse -> Int
httpStatus :: Prelude.Int,
    -- | The name of the created decoder manifest.
    CreateDecoderManifestResponse -> Text
name :: Prelude.Text,
    -- | The ARN of the created decoder manifest.
    CreateDecoderManifestResponse -> Text
arn :: Prelude.Text
  }
  deriving (CreateDecoderManifestResponse
-> CreateDecoderManifestResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateDecoderManifestResponse
-> CreateDecoderManifestResponse -> Bool
$c/= :: CreateDecoderManifestResponse
-> CreateDecoderManifestResponse -> Bool
== :: CreateDecoderManifestResponse
-> CreateDecoderManifestResponse -> Bool
$c== :: CreateDecoderManifestResponse
-> CreateDecoderManifestResponse -> Bool
Prelude.Eq, ReadPrec [CreateDecoderManifestResponse]
ReadPrec CreateDecoderManifestResponse
Int -> ReadS CreateDecoderManifestResponse
ReadS [CreateDecoderManifestResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateDecoderManifestResponse]
$creadListPrec :: ReadPrec [CreateDecoderManifestResponse]
readPrec :: ReadPrec CreateDecoderManifestResponse
$creadPrec :: ReadPrec CreateDecoderManifestResponse
readList :: ReadS [CreateDecoderManifestResponse]
$creadList :: ReadS [CreateDecoderManifestResponse]
readsPrec :: Int -> ReadS CreateDecoderManifestResponse
$creadsPrec :: Int -> ReadS CreateDecoderManifestResponse
Prelude.Read, Int -> CreateDecoderManifestResponse -> ShowS
[CreateDecoderManifestResponse] -> ShowS
CreateDecoderManifestResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateDecoderManifestResponse] -> ShowS
$cshowList :: [CreateDecoderManifestResponse] -> ShowS
show :: CreateDecoderManifestResponse -> String
$cshow :: CreateDecoderManifestResponse -> String
showsPrec :: Int -> CreateDecoderManifestResponse -> ShowS
$cshowsPrec :: Int -> CreateDecoderManifestResponse -> ShowS
Prelude.Show, forall x.
Rep CreateDecoderManifestResponse x
-> CreateDecoderManifestResponse
forall x.
CreateDecoderManifestResponse
-> Rep CreateDecoderManifestResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateDecoderManifestResponse x
-> CreateDecoderManifestResponse
$cfrom :: forall x.
CreateDecoderManifestResponse
-> Rep CreateDecoderManifestResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateDecoderManifestResponse' 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:
--
-- 'httpStatus', 'createDecoderManifestResponse_httpStatus' - The response's http status code.
--
-- 'name', 'createDecoderManifestResponse_name' - The name of the created decoder manifest.
--
-- 'arn', 'createDecoderManifestResponse_arn' - The ARN of the created decoder manifest.
newCreateDecoderManifestResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'name'
  Prelude.Text ->
  -- | 'arn'
  Prelude.Text ->
  CreateDecoderManifestResponse
newCreateDecoderManifestResponse :: Int -> Text -> Text -> CreateDecoderManifestResponse
newCreateDecoderManifestResponse
  Int
pHttpStatus_
  Text
pName_
  Text
pArn_ =
    CreateDecoderManifestResponse'
      { $sel:httpStatus:CreateDecoderManifestResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:name:CreateDecoderManifestResponse' :: Text
name = Text
pName_,
        $sel:arn:CreateDecoderManifestResponse' :: Text
arn = Text
pArn_
      }

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

-- | The name of the created decoder manifest.
createDecoderManifestResponse_name :: Lens.Lens' CreateDecoderManifestResponse Prelude.Text
createDecoderManifestResponse_name :: Lens' CreateDecoderManifestResponse Text
createDecoderManifestResponse_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDecoderManifestResponse' {Text
name :: Text
$sel:name:CreateDecoderManifestResponse' :: CreateDecoderManifestResponse -> Text
name} -> Text
name) (\s :: CreateDecoderManifestResponse
s@CreateDecoderManifestResponse' {} Text
a -> CreateDecoderManifestResponse
s {$sel:name:CreateDecoderManifestResponse' :: Text
name = Text
a} :: CreateDecoderManifestResponse)

-- | The ARN of the created decoder manifest.
createDecoderManifestResponse_arn :: Lens.Lens' CreateDecoderManifestResponse Prelude.Text
createDecoderManifestResponse_arn :: Lens' CreateDecoderManifestResponse Text
createDecoderManifestResponse_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDecoderManifestResponse' {Text
arn :: Text
$sel:arn:CreateDecoderManifestResponse' :: CreateDecoderManifestResponse -> Text
arn} -> Text
arn) (\s :: CreateDecoderManifestResponse
s@CreateDecoderManifestResponse' {} Text
a -> CreateDecoderManifestResponse
s {$sel:arn:CreateDecoderManifestResponse' :: Text
arn = Text
a} :: CreateDecoderManifestResponse)

instance Prelude.NFData CreateDecoderManifestResponse where
  rnf :: CreateDecoderManifestResponse -> ()
rnf CreateDecoderManifestResponse' {Int
Text
arn :: Text
name :: Text
httpStatus :: Int
$sel:arn:CreateDecoderManifestResponse' :: CreateDecoderManifestResponse -> Text
$sel:name:CreateDecoderManifestResponse' :: CreateDecoderManifestResponse -> Text
$sel:httpStatus:CreateDecoderManifestResponse' :: CreateDecoderManifestResponse -> Int
..} =
    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