{-# 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.AlexaBusiness.StartDeviceSync
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Resets a device and its account to the known default settings. This
-- clears all information and settings set by previous users in the
-- following ways:
--
-- -   Bluetooth - This unpairs all bluetooth devices paired with your echo
--     device.
--
-- -   Volume - This resets the echo device\'s volume to the default value.
--
-- -   Notifications - This clears all notifications from your echo device.
--
-- -   Lists - This clears all to-do items from your echo device.
--
-- -   Settings - This internally syncs the room\'s profile (if the device
--     is assigned to a room), contacts, address books, delegation access
--     for account linking, and communications (if enabled on the room
--     profile).
module Amazonka.AlexaBusiness.StartDeviceSync
  ( -- * Creating a Request
    StartDeviceSync (..),
    newStartDeviceSync,

    -- * Request Lenses
    startDeviceSync_deviceArn,
    startDeviceSync_roomArn,
    startDeviceSync_features,

    -- * Destructuring the Response
    StartDeviceSyncResponse (..),
    newStartDeviceSyncResponse,

    -- * Response Lenses
    startDeviceSyncResponse_httpStatus,
  )
where

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

-- | /See:/ 'newStartDeviceSync' smart constructor.
data StartDeviceSync = StartDeviceSync'
  { -- | The ARN of the device to sync. Required.
    StartDeviceSync -> Maybe Text
deviceArn :: Prelude.Maybe Prelude.Text,
    -- | The ARN of the room with which the device to sync is associated.
    -- Required.
    StartDeviceSync -> Maybe Text
roomArn :: Prelude.Maybe Prelude.Text,
    -- | Request structure to start the device sync. Required.
    StartDeviceSync -> [Feature]
features :: [Feature]
  }
  deriving (StartDeviceSync -> StartDeviceSync -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartDeviceSync -> StartDeviceSync -> Bool
$c/= :: StartDeviceSync -> StartDeviceSync -> Bool
== :: StartDeviceSync -> StartDeviceSync -> Bool
$c== :: StartDeviceSync -> StartDeviceSync -> Bool
Prelude.Eq, ReadPrec [StartDeviceSync]
ReadPrec StartDeviceSync
Int -> ReadS StartDeviceSync
ReadS [StartDeviceSync]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartDeviceSync]
$creadListPrec :: ReadPrec [StartDeviceSync]
readPrec :: ReadPrec StartDeviceSync
$creadPrec :: ReadPrec StartDeviceSync
readList :: ReadS [StartDeviceSync]
$creadList :: ReadS [StartDeviceSync]
readsPrec :: Int -> ReadS StartDeviceSync
$creadsPrec :: Int -> ReadS StartDeviceSync
Prelude.Read, Int -> StartDeviceSync -> ShowS
[StartDeviceSync] -> ShowS
StartDeviceSync -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartDeviceSync] -> ShowS
$cshowList :: [StartDeviceSync] -> ShowS
show :: StartDeviceSync -> String
$cshow :: StartDeviceSync -> String
showsPrec :: Int -> StartDeviceSync -> ShowS
$cshowsPrec :: Int -> StartDeviceSync -> ShowS
Prelude.Show, forall x. Rep StartDeviceSync x -> StartDeviceSync
forall x. StartDeviceSync -> Rep StartDeviceSync x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartDeviceSync x -> StartDeviceSync
$cfrom :: forall x. StartDeviceSync -> Rep StartDeviceSync x
Prelude.Generic)

-- |
-- Create a value of 'StartDeviceSync' 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:
--
-- 'deviceArn', 'startDeviceSync_deviceArn' - The ARN of the device to sync. Required.
--
-- 'roomArn', 'startDeviceSync_roomArn' - The ARN of the room with which the device to sync is associated.
-- Required.
--
-- 'features', 'startDeviceSync_features' - Request structure to start the device sync. Required.
newStartDeviceSync ::
  StartDeviceSync
newStartDeviceSync :: StartDeviceSync
newStartDeviceSync =
  StartDeviceSync'
    { $sel:deviceArn:StartDeviceSync' :: Maybe Text
deviceArn = forall a. Maybe a
Prelude.Nothing,
      $sel:roomArn:StartDeviceSync' :: Maybe Text
roomArn = forall a. Maybe a
Prelude.Nothing,
      $sel:features:StartDeviceSync' :: [Feature]
features = forall a. Monoid a => a
Prelude.mempty
    }

-- | The ARN of the device to sync. Required.
startDeviceSync_deviceArn :: Lens.Lens' StartDeviceSync (Prelude.Maybe Prelude.Text)
startDeviceSync_deviceArn :: Lens' StartDeviceSync (Maybe Text)
startDeviceSync_deviceArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartDeviceSync' {Maybe Text
deviceArn :: Maybe Text
$sel:deviceArn:StartDeviceSync' :: StartDeviceSync -> Maybe Text
deviceArn} -> Maybe Text
deviceArn) (\s :: StartDeviceSync
s@StartDeviceSync' {} Maybe Text
a -> StartDeviceSync
s {$sel:deviceArn:StartDeviceSync' :: Maybe Text
deviceArn = Maybe Text
a} :: StartDeviceSync)

-- | The ARN of the room with which the device to sync is associated.
-- Required.
startDeviceSync_roomArn :: Lens.Lens' StartDeviceSync (Prelude.Maybe Prelude.Text)
startDeviceSync_roomArn :: Lens' StartDeviceSync (Maybe Text)
startDeviceSync_roomArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartDeviceSync' {Maybe Text
roomArn :: Maybe Text
$sel:roomArn:StartDeviceSync' :: StartDeviceSync -> Maybe Text
roomArn} -> Maybe Text
roomArn) (\s :: StartDeviceSync
s@StartDeviceSync' {} Maybe Text
a -> StartDeviceSync
s {$sel:roomArn:StartDeviceSync' :: Maybe Text
roomArn = Maybe Text
a} :: StartDeviceSync)

-- | Request structure to start the device sync. Required.
startDeviceSync_features :: Lens.Lens' StartDeviceSync [Feature]
startDeviceSync_features :: Lens' StartDeviceSync [Feature]
startDeviceSync_features = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartDeviceSync' {[Feature]
features :: [Feature]
$sel:features:StartDeviceSync' :: StartDeviceSync -> [Feature]
features} -> [Feature]
features) (\s :: StartDeviceSync
s@StartDeviceSync' {} [Feature]
a -> StartDeviceSync
s {$sel:features:StartDeviceSync' :: [Feature]
features = [Feature]
a} :: StartDeviceSync) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest StartDeviceSync where
  type
    AWSResponse StartDeviceSync =
      StartDeviceSyncResponse
  request :: (Service -> Service) -> StartDeviceSync -> Request StartDeviceSync
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 StartDeviceSync
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse StartDeviceSync)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> StartDeviceSyncResponse
StartDeviceSyncResponse'
            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))
      )

instance Prelude.Hashable StartDeviceSync where
  hashWithSalt :: Int -> StartDeviceSync -> Int
hashWithSalt Int
_salt StartDeviceSync' {[Feature]
Maybe Text
features :: [Feature]
roomArn :: Maybe Text
deviceArn :: Maybe Text
$sel:features:StartDeviceSync' :: StartDeviceSync -> [Feature]
$sel:roomArn:StartDeviceSync' :: StartDeviceSync -> Maybe Text
$sel:deviceArn:StartDeviceSync' :: StartDeviceSync -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
deviceArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
roomArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Feature]
features

instance Prelude.NFData StartDeviceSync where
  rnf :: StartDeviceSync -> ()
rnf StartDeviceSync' {[Feature]
Maybe Text
features :: [Feature]
roomArn :: Maybe Text
deviceArn :: Maybe Text
$sel:features:StartDeviceSync' :: StartDeviceSync -> [Feature]
$sel:roomArn:StartDeviceSync' :: StartDeviceSync -> Maybe Text
$sel:deviceArn:StartDeviceSync' :: StartDeviceSync -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
deviceArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
roomArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Feature]
features

instance Data.ToHeaders StartDeviceSync where
  toHeaders :: StartDeviceSync -> 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
"AlexaForBusiness.StartDeviceSync" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON StartDeviceSync where
  toJSON :: StartDeviceSync -> Value
toJSON StartDeviceSync' {[Feature]
Maybe Text
features :: [Feature]
roomArn :: Maybe Text
deviceArn :: Maybe Text
$sel:features:StartDeviceSync' :: StartDeviceSync -> [Feature]
$sel:roomArn:StartDeviceSync' :: StartDeviceSync -> Maybe Text
$sel:deviceArn:StartDeviceSync' :: StartDeviceSync -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"DeviceArn" 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
deviceArn,
            (Key
"RoomArn" 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
roomArn,
            forall a. a -> Maybe a
Prelude.Just (Key
"Features" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [Feature]
features)
          ]
      )

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

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

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

-- |
-- Create a value of 'StartDeviceSyncResponse' 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', 'startDeviceSyncResponse_httpStatus' - The response's http status code.
newStartDeviceSyncResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  StartDeviceSyncResponse
newStartDeviceSyncResponse :: Int -> StartDeviceSyncResponse
newStartDeviceSyncResponse Int
pHttpStatus_ =
  StartDeviceSyncResponse' {$sel:httpStatus:StartDeviceSyncResponse' :: Int
httpStatus = Int
pHttpStatus_}

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

instance Prelude.NFData StartDeviceSyncResponse where
  rnf :: StartDeviceSyncResponse -> ()
rnf StartDeviceSyncResponse' {Int
httpStatus :: Int
$sel:httpStatus:StartDeviceSyncResponse' :: StartDeviceSyncResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus