{-# 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.IoT1ClickDevices.InvokeDeviceMethod
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Given a device ID, issues a request to invoke a named device method
-- (with possible parameters). See the \"Example POST\" code snippet below.
module Amazonka.IoT1ClickDevices.InvokeDeviceMethod
  ( -- * Creating a Request
    InvokeDeviceMethod (..),
    newInvokeDeviceMethod,

    -- * Request Lenses
    invokeDeviceMethod_deviceMethod,
    invokeDeviceMethod_deviceMethodParameters,
    invokeDeviceMethod_deviceId,

    -- * Destructuring the Response
    InvokeDeviceMethodResponse (..),
    newInvokeDeviceMethodResponse,

    -- * Response Lenses
    invokeDeviceMethodResponse_deviceMethodResponse,
    invokeDeviceMethodResponse_httpStatus,
  )
where

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

-- | /See:/ 'newInvokeDeviceMethod' smart constructor.
data InvokeDeviceMethod = InvokeDeviceMethod'
  { -- | The device method to invoke.
    InvokeDeviceMethod -> Maybe DeviceMethod
deviceMethod :: Prelude.Maybe DeviceMethod,
    -- | A JSON encoded string containing the device method request parameters.
    InvokeDeviceMethod -> Maybe Text
deviceMethodParameters :: Prelude.Maybe Prelude.Text,
    -- | The unique identifier of the device.
    InvokeDeviceMethod -> Text
deviceId :: Prelude.Text
  }
  deriving (InvokeDeviceMethod -> InvokeDeviceMethod -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InvokeDeviceMethod -> InvokeDeviceMethod -> Bool
$c/= :: InvokeDeviceMethod -> InvokeDeviceMethod -> Bool
== :: InvokeDeviceMethod -> InvokeDeviceMethod -> Bool
$c== :: InvokeDeviceMethod -> InvokeDeviceMethod -> Bool
Prelude.Eq, ReadPrec [InvokeDeviceMethod]
ReadPrec InvokeDeviceMethod
Int -> ReadS InvokeDeviceMethod
ReadS [InvokeDeviceMethod]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InvokeDeviceMethod]
$creadListPrec :: ReadPrec [InvokeDeviceMethod]
readPrec :: ReadPrec InvokeDeviceMethod
$creadPrec :: ReadPrec InvokeDeviceMethod
readList :: ReadS [InvokeDeviceMethod]
$creadList :: ReadS [InvokeDeviceMethod]
readsPrec :: Int -> ReadS InvokeDeviceMethod
$creadsPrec :: Int -> ReadS InvokeDeviceMethod
Prelude.Read, Int -> InvokeDeviceMethod -> ShowS
[InvokeDeviceMethod] -> ShowS
InvokeDeviceMethod -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InvokeDeviceMethod] -> ShowS
$cshowList :: [InvokeDeviceMethod] -> ShowS
show :: InvokeDeviceMethod -> String
$cshow :: InvokeDeviceMethod -> String
showsPrec :: Int -> InvokeDeviceMethod -> ShowS
$cshowsPrec :: Int -> InvokeDeviceMethod -> ShowS
Prelude.Show, forall x. Rep InvokeDeviceMethod x -> InvokeDeviceMethod
forall x. InvokeDeviceMethod -> Rep InvokeDeviceMethod x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InvokeDeviceMethod x -> InvokeDeviceMethod
$cfrom :: forall x. InvokeDeviceMethod -> Rep InvokeDeviceMethod x
Prelude.Generic)

-- |
-- Create a value of 'InvokeDeviceMethod' 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:
--
-- 'deviceMethod', 'invokeDeviceMethod_deviceMethod' - The device method to invoke.
--
-- 'deviceMethodParameters', 'invokeDeviceMethod_deviceMethodParameters' - A JSON encoded string containing the device method request parameters.
--
-- 'deviceId', 'invokeDeviceMethod_deviceId' - The unique identifier of the device.
newInvokeDeviceMethod ::
  -- | 'deviceId'
  Prelude.Text ->
  InvokeDeviceMethod
newInvokeDeviceMethod :: Text -> InvokeDeviceMethod
newInvokeDeviceMethod Text
pDeviceId_ =
  InvokeDeviceMethod'
    { $sel:deviceMethod:InvokeDeviceMethod' :: Maybe DeviceMethod
deviceMethod = forall a. Maybe a
Prelude.Nothing,
      $sel:deviceMethodParameters:InvokeDeviceMethod' :: Maybe Text
deviceMethodParameters = forall a. Maybe a
Prelude.Nothing,
      $sel:deviceId:InvokeDeviceMethod' :: Text
deviceId = Text
pDeviceId_
    }

-- | The device method to invoke.
invokeDeviceMethod_deviceMethod :: Lens.Lens' InvokeDeviceMethod (Prelude.Maybe DeviceMethod)
invokeDeviceMethod_deviceMethod :: Lens' InvokeDeviceMethod (Maybe DeviceMethod)
invokeDeviceMethod_deviceMethod = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InvokeDeviceMethod' {Maybe DeviceMethod
deviceMethod :: Maybe DeviceMethod
$sel:deviceMethod:InvokeDeviceMethod' :: InvokeDeviceMethod -> Maybe DeviceMethod
deviceMethod} -> Maybe DeviceMethod
deviceMethod) (\s :: InvokeDeviceMethod
s@InvokeDeviceMethod' {} Maybe DeviceMethod
a -> InvokeDeviceMethod
s {$sel:deviceMethod:InvokeDeviceMethod' :: Maybe DeviceMethod
deviceMethod = Maybe DeviceMethod
a} :: InvokeDeviceMethod)

-- | A JSON encoded string containing the device method request parameters.
invokeDeviceMethod_deviceMethodParameters :: Lens.Lens' InvokeDeviceMethod (Prelude.Maybe Prelude.Text)
invokeDeviceMethod_deviceMethodParameters :: Lens' InvokeDeviceMethod (Maybe Text)
invokeDeviceMethod_deviceMethodParameters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InvokeDeviceMethod' {Maybe Text
deviceMethodParameters :: Maybe Text
$sel:deviceMethodParameters:InvokeDeviceMethod' :: InvokeDeviceMethod -> Maybe Text
deviceMethodParameters} -> Maybe Text
deviceMethodParameters) (\s :: InvokeDeviceMethod
s@InvokeDeviceMethod' {} Maybe Text
a -> InvokeDeviceMethod
s {$sel:deviceMethodParameters:InvokeDeviceMethod' :: Maybe Text
deviceMethodParameters = Maybe Text
a} :: InvokeDeviceMethod)

-- | The unique identifier of the device.
invokeDeviceMethod_deviceId :: Lens.Lens' InvokeDeviceMethod Prelude.Text
invokeDeviceMethod_deviceId :: Lens' InvokeDeviceMethod Text
invokeDeviceMethod_deviceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InvokeDeviceMethod' {Text
deviceId :: Text
$sel:deviceId:InvokeDeviceMethod' :: InvokeDeviceMethod -> Text
deviceId} -> Text
deviceId) (\s :: InvokeDeviceMethod
s@InvokeDeviceMethod' {} Text
a -> InvokeDeviceMethod
s {$sel:deviceId:InvokeDeviceMethod' :: Text
deviceId = Text
a} :: InvokeDeviceMethod)

instance Core.AWSRequest InvokeDeviceMethod where
  type
    AWSResponse InvokeDeviceMethod =
      InvokeDeviceMethodResponse
  request :: (Service -> Service)
-> InvokeDeviceMethod -> Request InvokeDeviceMethod
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 InvokeDeviceMethod
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse InvokeDeviceMethod)))
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 -> Int -> InvokeDeviceMethodResponse
InvokeDeviceMethodResponse'
            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
"deviceMethodResponse")
            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 InvokeDeviceMethod where
  hashWithSalt :: Int -> InvokeDeviceMethod -> Int
hashWithSalt Int
_salt InvokeDeviceMethod' {Maybe Text
Maybe DeviceMethod
Text
deviceId :: Text
deviceMethodParameters :: Maybe Text
deviceMethod :: Maybe DeviceMethod
$sel:deviceId:InvokeDeviceMethod' :: InvokeDeviceMethod -> Text
$sel:deviceMethodParameters:InvokeDeviceMethod' :: InvokeDeviceMethod -> Maybe Text
$sel:deviceMethod:InvokeDeviceMethod' :: InvokeDeviceMethod -> Maybe DeviceMethod
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DeviceMethod
deviceMethod
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
deviceMethodParameters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
deviceId

instance Prelude.NFData InvokeDeviceMethod where
  rnf :: InvokeDeviceMethod -> ()
rnf InvokeDeviceMethod' {Maybe Text
Maybe DeviceMethod
Text
deviceId :: Text
deviceMethodParameters :: Maybe Text
deviceMethod :: Maybe DeviceMethod
$sel:deviceId:InvokeDeviceMethod' :: InvokeDeviceMethod -> Text
$sel:deviceMethodParameters:InvokeDeviceMethod' :: InvokeDeviceMethod -> Maybe Text
$sel:deviceMethod:InvokeDeviceMethod' :: InvokeDeviceMethod -> Maybe DeviceMethod
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe DeviceMethod
deviceMethod
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
deviceMethodParameters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
deviceId

instance Data.ToHeaders InvokeDeviceMethod where
  toHeaders :: InvokeDeviceMethod -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON InvokeDeviceMethod where
  toJSON :: InvokeDeviceMethod -> Value
toJSON InvokeDeviceMethod' {Maybe Text
Maybe DeviceMethod
Text
deviceId :: Text
deviceMethodParameters :: Maybe Text
deviceMethod :: Maybe DeviceMethod
$sel:deviceId:InvokeDeviceMethod' :: InvokeDeviceMethod -> Text
$sel:deviceMethodParameters:InvokeDeviceMethod' :: InvokeDeviceMethod -> Maybe Text
$sel:deviceMethod:InvokeDeviceMethod' :: InvokeDeviceMethod -> Maybe DeviceMethod
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"deviceMethod" 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 DeviceMethod
deviceMethod,
            (Key
"deviceMethodParameters" 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
deviceMethodParameters
          ]
      )

instance Data.ToPath InvokeDeviceMethod where
  toPath :: InvokeDeviceMethod -> ByteString
toPath InvokeDeviceMethod' {Maybe Text
Maybe DeviceMethod
Text
deviceId :: Text
deviceMethodParameters :: Maybe Text
deviceMethod :: Maybe DeviceMethod
$sel:deviceId:InvokeDeviceMethod' :: InvokeDeviceMethod -> Text
$sel:deviceMethodParameters:InvokeDeviceMethod' :: InvokeDeviceMethod -> Maybe Text
$sel:deviceMethod:InvokeDeviceMethod' :: InvokeDeviceMethod -> Maybe DeviceMethod
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/devices/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
deviceId, ByteString
"/methods"]

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

-- | /See:/ 'newInvokeDeviceMethodResponse' smart constructor.
data InvokeDeviceMethodResponse = InvokeDeviceMethodResponse'
  { -- | A JSON encoded string containing the device method response.
    InvokeDeviceMethodResponse -> Maybe Text
deviceMethodResponse :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    InvokeDeviceMethodResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (InvokeDeviceMethodResponse -> InvokeDeviceMethodResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InvokeDeviceMethodResponse -> InvokeDeviceMethodResponse -> Bool
$c/= :: InvokeDeviceMethodResponse -> InvokeDeviceMethodResponse -> Bool
== :: InvokeDeviceMethodResponse -> InvokeDeviceMethodResponse -> Bool
$c== :: InvokeDeviceMethodResponse -> InvokeDeviceMethodResponse -> Bool
Prelude.Eq, ReadPrec [InvokeDeviceMethodResponse]
ReadPrec InvokeDeviceMethodResponse
Int -> ReadS InvokeDeviceMethodResponse
ReadS [InvokeDeviceMethodResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InvokeDeviceMethodResponse]
$creadListPrec :: ReadPrec [InvokeDeviceMethodResponse]
readPrec :: ReadPrec InvokeDeviceMethodResponse
$creadPrec :: ReadPrec InvokeDeviceMethodResponse
readList :: ReadS [InvokeDeviceMethodResponse]
$creadList :: ReadS [InvokeDeviceMethodResponse]
readsPrec :: Int -> ReadS InvokeDeviceMethodResponse
$creadsPrec :: Int -> ReadS InvokeDeviceMethodResponse
Prelude.Read, Int -> InvokeDeviceMethodResponse -> ShowS
[InvokeDeviceMethodResponse] -> ShowS
InvokeDeviceMethodResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InvokeDeviceMethodResponse] -> ShowS
$cshowList :: [InvokeDeviceMethodResponse] -> ShowS
show :: InvokeDeviceMethodResponse -> String
$cshow :: InvokeDeviceMethodResponse -> String
showsPrec :: Int -> InvokeDeviceMethodResponse -> ShowS
$cshowsPrec :: Int -> InvokeDeviceMethodResponse -> ShowS
Prelude.Show, forall x.
Rep InvokeDeviceMethodResponse x -> InvokeDeviceMethodResponse
forall x.
InvokeDeviceMethodResponse -> Rep InvokeDeviceMethodResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep InvokeDeviceMethodResponse x -> InvokeDeviceMethodResponse
$cfrom :: forall x.
InvokeDeviceMethodResponse -> Rep InvokeDeviceMethodResponse x
Prelude.Generic)

-- |
-- Create a value of 'InvokeDeviceMethodResponse' 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:
--
-- 'deviceMethodResponse', 'invokeDeviceMethodResponse_deviceMethodResponse' - A JSON encoded string containing the device method response.
--
-- 'httpStatus', 'invokeDeviceMethodResponse_httpStatus' - The response's http status code.
newInvokeDeviceMethodResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  InvokeDeviceMethodResponse
newInvokeDeviceMethodResponse :: Int -> InvokeDeviceMethodResponse
newInvokeDeviceMethodResponse Int
pHttpStatus_ =
  InvokeDeviceMethodResponse'
    { $sel:deviceMethodResponse:InvokeDeviceMethodResponse' :: Maybe Text
deviceMethodResponse =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:InvokeDeviceMethodResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A JSON encoded string containing the device method response.
invokeDeviceMethodResponse_deviceMethodResponse :: Lens.Lens' InvokeDeviceMethodResponse (Prelude.Maybe Prelude.Text)
invokeDeviceMethodResponse_deviceMethodResponse :: Lens' InvokeDeviceMethodResponse (Maybe Text)
invokeDeviceMethodResponse_deviceMethodResponse = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InvokeDeviceMethodResponse' {Maybe Text
deviceMethodResponse :: Maybe Text
$sel:deviceMethodResponse:InvokeDeviceMethodResponse' :: InvokeDeviceMethodResponse -> Maybe Text
deviceMethodResponse} -> Maybe Text
deviceMethodResponse) (\s :: InvokeDeviceMethodResponse
s@InvokeDeviceMethodResponse' {} Maybe Text
a -> InvokeDeviceMethodResponse
s {$sel:deviceMethodResponse:InvokeDeviceMethodResponse' :: Maybe Text
deviceMethodResponse = Maybe Text
a} :: InvokeDeviceMethodResponse)

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

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