{-# 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.IoTEvents.DescribeInput
-- 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 an input.
module Amazonka.IoTEvents.DescribeInput
  ( -- * Creating a Request
    DescribeInput (..),
    newDescribeInput,

    -- * Request Lenses
    describeInput_inputName,

    -- * Destructuring the Response
    DescribeInputResponse (..),
    newDescribeInputResponse,

    -- * Response Lenses
    describeInputResponse_input,
    describeInputResponse_httpStatus,
  )
where

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

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

-- |
-- Create a value of 'DescribeInput' 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:
--
-- 'inputName', 'describeInput_inputName' - The name of the input.
newDescribeInput ::
  -- | 'inputName'
  Prelude.Text ->
  DescribeInput
newDescribeInput :: Text -> DescribeInput
newDescribeInput Text
pInputName_ =
  DescribeInput' {$sel:inputName:DescribeInput' :: Text
inputName = Text
pInputName_}

-- | The name of the input.
describeInput_inputName :: Lens.Lens' DescribeInput Prelude.Text
describeInput_inputName :: Lens' DescribeInput Text
describeInput_inputName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeInput' {Text
inputName :: Text
$sel:inputName:DescribeInput' :: DescribeInput -> Text
inputName} -> Text
inputName) (\s :: DescribeInput
s@DescribeInput' {} Text
a -> DescribeInput
s {$sel:inputName:DescribeInput' :: Text
inputName = Text
a} :: DescribeInput)

instance Core.AWSRequest DescribeInput where
  type
    AWSResponse DescribeInput =
      DescribeInputResponse
  request :: (Service -> Service) -> DescribeInput -> Request DescribeInput
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DescribeInput
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DescribeInput)))
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 Input -> Int -> DescribeInputResponse
DescribeInputResponse'
            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
"input")
            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 DescribeInput where
  hashWithSalt :: Int -> DescribeInput -> Int
hashWithSalt Int
_salt DescribeInput' {Text
inputName :: Text
$sel:inputName:DescribeInput' :: DescribeInput -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
inputName

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

instance Data.ToHeaders DescribeInput where
  toHeaders :: DescribeInput -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToPath DescribeInput where
  toPath :: DescribeInput -> ByteString
toPath DescribeInput' {Text
inputName :: Text
$sel:inputName:DescribeInput' :: DescribeInput -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"/inputs/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
inputName]

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

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

-- |
-- Create a value of 'DescribeInputResponse' 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:
--
-- 'input', 'describeInputResponse_input' - Information about the input.
--
-- 'httpStatus', 'describeInputResponse_httpStatus' - The response's http status code.
newDescribeInputResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeInputResponse
newDescribeInputResponse :: Int -> DescribeInputResponse
newDescribeInputResponse Int
pHttpStatus_ =
  DescribeInputResponse'
    { $sel:input:DescribeInputResponse' :: Maybe Input
input = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeInputResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the input.
describeInputResponse_input :: Lens.Lens' DescribeInputResponse (Prelude.Maybe Input)
describeInputResponse_input :: Lens' DescribeInputResponse (Maybe Input)
describeInputResponse_input = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeInputResponse' {Maybe Input
input :: Maybe Input
$sel:input:DescribeInputResponse' :: DescribeInputResponse -> Maybe Input
input} -> Maybe Input
input) (\s :: DescribeInputResponse
s@DescribeInputResponse' {} Maybe Input
a -> DescribeInputResponse
s {$sel:input:DescribeInputResponse' :: Maybe Input
input = Maybe Input
a} :: DescribeInputResponse)

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

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