{-# 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 #-}
module Amazonka.IoTEvents.CreateInput
(
CreateInput (..),
newCreateInput,
createInput_inputDescription,
createInput_tags,
createInput_inputName,
createInput_inputDefinition,
CreateInputResponse (..),
newCreateInputResponse,
createInputResponse_inputConfiguration,
createInputResponse_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
data CreateInput = CreateInput'
{
CreateInput -> Maybe Text
inputDescription :: Prelude.Maybe Prelude.Text,
CreateInput -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
CreateInput -> Text
inputName :: Prelude.Text,
CreateInput -> InputDefinition
inputDefinition :: InputDefinition
}
deriving (CreateInput -> CreateInput -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateInput -> CreateInput -> Bool
$c/= :: CreateInput -> CreateInput -> Bool
== :: CreateInput -> CreateInput -> Bool
$c== :: CreateInput -> CreateInput -> Bool
Prelude.Eq, ReadPrec [CreateInput]
ReadPrec CreateInput
Int -> ReadS CreateInput
ReadS [CreateInput]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateInput]
$creadListPrec :: ReadPrec [CreateInput]
readPrec :: ReadPrec CreateInput
$creadPrec :: ReadPrec CreateInput
readList :: ReadS [CreateInput]
$creadList :: ReadS [CreateInput]
readsPrec :: Int -> ReadS CreateInput
$creadsPrec :: Int -> ReadS CreateInput
Prelude.Read, Int -> CreateInput -> ShowS
[CreateInput] -> ShowS
CreateInput -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateInput] -> ShowS
$cshowList :: [CreateInput] -> ShowS
show :: CreateInput -> String
$cshow :: CreateInput -> String
showsPrec :: Int -> CreateInput -> ShowS
$cshowsPrec :: Int -> CreateInput -> ShowS
Prelude.Show, forall x. Rep CreateInput x -> CreateInput
forall x. CreateInput -> Rep CreateInput x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateInput x -> CreateInput
$cfrom :: forall x. CreateInput -> Rep CreateInput x
Prelude.Generic)
newCreateInput ::
Prelude.Text ->
InputDefinition ->
CreateInput
newCreateInput :: Text -> InputDefinition -> CreateInput
newCreateInput Text
pInputName_ InputDefinition
pInputDefinition_ =
CreateInput'
{ $sel:inputDescription:CreateInput' :: Maybe Text
inputDescription = forall a. Maybe a
Prelude.Nothing,
$sel:tags:CreateInput' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
$sel:inputName:CreateInput' :: Text
inputName = Text
pInputName_,
$sel:inputDefinition:CreateInput' :: InputDefinition
inputDefinition = InputDefinition
pInputDefinition_
}
createInput_inputDescription :: Lens.Lens' CreateInput (Prelude.Maybe Prelude.Text)
createInput_inputDescription :: Lens' CreateInput (Maybe Text)
createInput_inputDescription = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInput' {Maybe Text
inputDescription :: Maybe Text
$sel:inputDescription:CreateInput' :: CreateInput -> Maybe Text
inputDescription} -> Maybe Text
inputDescription) (\s :: CreateInput
s@CreateInput' {} Maybe Text
a -> CreateInput
s {$sel:inputDescription:CreateInput' :: Maybe Text
inputDescription = Maybe Text
a} :: CreateInput)
createInput_tags :: Lens.Lens' CreateInput (Prelude.Maybe [Tag])
createInput_tags :: Lens' CreateInput (Maybe [Tag])
createInput_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInput' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateInput' :: CreateInput -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateInput
s@CreateInput' {} Maybe [Tag]
a -> CreateInput
s {$sel:tags:CreateInput' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateInput) 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
createInput_inputName :: Lens.Lens' CreateInput Prelude.Text
createInput_inputName :: Lens' CreateInput Text
createInput_inputName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInput' {Text
inputName :: Text
$sel:inputName:CreateInput' :: CreateInput -> Text
inputName} -> Text
inputName) (\s :: CreateInput
s@CreateInput' {} Text
a -> CreateInput
s {$sel:inputName:CreateInput' :: Text
inputName = Text
a} :: CreateInput)
createInput_inputDefinition :: Lens.Lens' CreateInput InputDefinition
createInput_inputDefinition :: Lens' CreateInput InputDefinition
createInput_inputDefinition = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInput' {InputDefinition
inputDefinition :: InputDefinition
$sel:inputDefinition:CreateInput' :: CreateInput -> InputDefinition
inputDefinition} -> InputDefinition
inputDefinition) (\s :: CreateInput
s@CreateInput' {} InputDefinition
a -> CreateInput
s {$sel:inputDefinition:CreateInput' :: InputDefinition
inputDefinition = InputDefinition
a} :: CreateInput)
instance Core.AWSRequest CreateInput where
type AWSResponse CreateInput = CreateInputResponse
request :: (Service -> Service) -> CreateInput -> Request CreateInput
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 CreateInput
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateInput)))
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 InputConfiguration -> Int -> CreateInputResponse
CreateInputResponse'
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
"inputConfiguration")
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 CreateInput where
hashWithSalt :: Int -> CreateInput -> Int
hashWithSalt Int
_salt CreateInput' {Maybe [Tag]
Maybe Text
Text
InputDefinition
inputDefinition :: InputDefinition
inputName :: Text
tags :: Maybe [Tag]
inputDescription :: Maybe Text
$sel:inputDefinition:CreateInput' :: CreateInput -> InputDefinition
$sel:inputName:CreateInput' :: CreateInput -> Text
$sel:tags:CreateInput' :: CreateInput -> Maybe [Tag]
$sel:inputDescription:CreateInput' :: CreateInput -> Maybe Text
..} =
Int
_salt
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
inputDescription
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
inputName
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` InputDefinition
inputDefinition
instance Prelude.NFData CreateInput where
rnf :: CreateInput -> ()
rnf CreateInput' {Maybe [Tag]
Maybe Text
Text
InputDefinition
inputDefinition :: InputDefinition
inputName :: Text
tags :: Maybe [Tag]
inputDescription :: Maybe Text
$sel:inputDefinition:CreateInput' :: CreateInput -> InputDefinition
$sel:inputName:CreateInput' :: CreateInput -> Text
$sel:tags:CreateInput' :: CreateInput -> Maybe [Tag]
$sel:inputDescription:CreateInput' :: CreateInput -> Maybe Text
..} =
forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
inputDescription
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
inputName
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf InputDefinition
inputDefinition
instance Data.ToHeaders CreateInput where
toHeaders :: CreateInput -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty
instance Data.ToJSON CreateInput where
toJSON :: CreateInput -> Value
toJSON CreateInput' {Maybe [Tag]
Maybe Text
Text
InputDefinition
inputDefinition :: InputDefinition
inputName :: Text
tags :: Maybe [Tag]
inputDescription :: Maybe Text
$sel:inputDefinition:CreateInput' :: CreateInput -> InputDefinition
$sel:inputName:CreateInput' :: CreateInput -> Text
$sel:tags:CreateInput' :: CreateInput -> Maybe [Tag]
$sel:inputDescription:CreateInput' :: CreateInput -> Maybe Text
..} =
[Pair] -> Value
Data.object
( forall a. [Maybe a] -> [a]
Prelude.catMaybes
[ (Key
"inputDescription" 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
inputDescription,
(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
"inputName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
inputName),
forall a. a -> Maybe a
Prelude.Just
(Key
"inputDefinition" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= InputDefinition
inputDefinition)
]
)
instance Data.ToPath CreateInput where
toPath :: CreateInput -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/inputs"
instance Data.ToQuery CreateInput where
toQuery :: CreateInput -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty
data CreateInputResponse = CreateInputResponse'
{
CreateInputResponse -> Maybe InputConfiguration
inputConfiguration :: Prelude.Maybe InputConfiguration,
CreateInputResponse -> Int
httpStatus :: Prelude.Int
}
deriving (CreateInputResponse -> CreateInputResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateInputResponse -> CreateInputResponse -> Bool
$c/= :: CreateInputResponse -> CreateInputResponse -> Bool
== :: CreateInputResponse -> CreateInputResponse -> Bool
$c== :: CreateInputResponse -> CreateInputResponse -> Bool
Prelude.Eq, ReadPrec [CreateInputResponse]
ReadPrec CreateInputResponse
Int -> ReadS CreateInputResponse
ReadS [CreateInputResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateInputResponse]
$creadListPrec :: ReadPrec [CreateInputResponse]
readPrec :: ReadPrec CreateInputResponse
$creadPrec :: ReadPrec CreateInputResponse
readList :: ReadS [CreateInputResponse]
$creadList :: ReadS [CreateInputResponse]
readsPrec :: Int -> ReadS CreateInputResponse
$creadsPrec :: Int -> ReadS CreateInputResponse
Prelude.Read, Int -> CreateInputResponse -> ShowS
[CreateInputResponse] -> ShowS
CreateInputResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateInputResponse] -> ShowS
$cshowList :: [CreateInputResponse] -> ShowS
show :: CreateInputResponse -> String
$cshow :: CreateInputResponse -> String
showsPrec :: Int -> CreateInputResponse -> ShowS
$cshowsPrec :: Int -> CreateInputResponse -> ShowS
Prelude.Show, forall x. Rep CreateInputResponse x -> CreateInputResponse
forall x. CreateInputResponse -> Rep CreateInputResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateInputResponse x -> CreateInputResponse
$cfrom :: forall x. CreateInputResponse -> Rep CreateInputResponse x
Prelude.Generic)
newCreateInputResponse ::
Prelude.Int ->
CreateInputResponse
newCreateInputResponse :: Int -> CreateInputResponse
newCreateInputResponse Int
pHttpStatus_ =
CreateInputResponse'
{ $sel:inputConfiguration:CreateInputResponse' :: Maybe InputConfiguration
inputConfiguration =
forall a. Maybe a
Prelude.Nothing,
$sel:httpStatus:CreateInputResponse' :: Int
httpStatus = Int
pHttpStatus_
}
createInputResponse_inputConfiguration :: Lens.Lens' CreateInputResponse (Prelude.Maybe InputConfiguration)
createInputResponse_inputConfiguration :: Lens' CreateInputResponse (Maybe InputConfiguration)
createInputResponse_inputConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInputResponse' {Maybe InputConfiguration
inputConfiguration :: Maybe InputConfiguration
$sel:inputConfiguration:CreateInputResponse' :: CreateInputResponse -> Maybe InputConfiguration
inputConfiguration} -> Maybe InputConfiguration
inputConfiguration) (\s :: CreateInputResponse
s@CreateInputResponse' {} Maybe InputConfiguration
a -> CreateInputResponse
s {$sel:inputConfiguration:CreateInputResponse' :: Maybe InputConfiguration
inputConfiguration = Maybe InputConfiguration
a} :: CreateInputResponse)
createInputResponse_httpStatus :: Lens.Lens' CreateInputResponse Prelude.Int
createInputResponse_httpStatus :: Lens' CreateInputResponse Int
createInputResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInputResponse' {Int
httpStatus :: Int
$sel:httpStatus:CreateInputResponse' :: CreateInputResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: CreateInputResponse
s@CreateInputResponse' {} Int
a -> CreateInputResponse
s {$sel:httpStatus:CreateInputResponse' :: Int
httpStatus = Int
a} :: CreateInputResponse)
instance Prelude.NFData CreateInputResponse where
rnf :: CreateInputResponse -> ()
rnf CreateInputResponse' {Int
Maybe InputConfiguration
httpStatus :: Int
inputConfiguration :: Maybe InputConfiguration
$sel:httpStatus:CreateInputResponse' :: CreateInputResponse -> Int
$sel:inputConfiguration:CreateInputResponse' :: CreateInputResponse -> Maybe InputConfiguration
..} =
forall a. NFData a => a -> ()
Prelude.rnf Maybe InputConfiguration
inputConfiguration
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus