{-# 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.CognitoSync.SubscribeToDataset
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Subscribes to receive notifications when a dataset is modified by
-- another device.
--
-- This API can only be called with temporary credentials provided by
-- Cognito Identity. You cannot call this API with developer credentials.
module Amazonka.CognitoSync.SubscribeToDataset
  ( -- * Creating a Request
    SubscribeToDataset (..),
    newSubscribeToDataset,

    -- * Request Lenses
    subscribeToDataset_identityPoolId,
    subscribeToDataset_identityId,
    subscribeToDataset_datasetName,
    subscribeToDataset_deviceId,

    -- * Destructuring the Response
    SubscribeToDatasetResponse (..),
    newSubscribeToDatasetResponse,

    -- * Response Lenses
    subscribeToDatasetResponse_httpStatus,
  )
where

import Amazonka.CognitoSync.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

-- | A request to SubscribeToDatasetRequest.
--
-- /See:/ 'newSubscribeToDataset' smart constructor.
data SubscribeToDataset = SubscribeToDataset'
  { -- | A name-spaced GUID (for example,
    -- us-east-1:23EC4050-6AEA-7089-A2DD-08002EXAMPLE) created by Amazon
    -- Cognito. The ID of the pool to which the identity belongs.
    SubscribeToDataset -> Text
identityPoolId :: Prelude.Text,
    -- | Unique ID for this identity.
    SubscribeToDataset -> Text
identityId :: Prelude.Text,
    -- | The name of the dataset to subcribe to.
    SubscribeToDataset -> Text
datasetName :: Prelude.Text,
    -- | The unique ID generated for this device by Cognito.
    SubscribeToDataset -> Text
deviceId :: Prelude.Text
  }
  deriving (SubscribeToDataset -> SubscribeToDataset -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SubscribeToDataset -> SubscribeToDataset -> Bool
$c/= :: SubscribeToDataset -> SubscribeToDataset -> Bool
== :: SubscribeToDataset -> SubscribeToDataset -> Bool
$c== :: SubscribeToDataset -> SubscribeToDataset -> Bool
Prelude.Eq, ReadPrec [SubscribeToDataset]
ReadPrec SubscribeToDataset
Int -> ReadS SubscribeToDataset
ReadS [SubscribeToDataset]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SubscribeToDataset]
$creadListPrec :: ReadPrec [SubscribeToDataset]
readPrec :: ReadPrec SubscribeToDataset
$creadPrec :: ReadPrec SubscribeToDataset
readList :: ReadS [SubscribeToDataset]
$creadList :: ReadS [SubscribeToDataset]
readsPrec :: Int -> ReadS SubscribeToDataset
$creadsPrec :: Int -> ReadS SubscribeToDataset
Prelude.Read, Int -> SubscribeToDataset -> ShowS
[SubscribeToDataset] -> ShowS
SubscribeToDataset -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SubscribeToDataset] -> ShowS
$cshowList :: [SubscribeToDataset] -> ShowS
show :: SubscribeToDataset -> String
$cshow :: SubscribeToDataset -> String
showsPrec :: Int -> SubscribeToDataset -> ShowS
$cshowsPrec :: Int -> SubscribeToDataset -> ShowS
Prelude.Show, forall x. Rep SubscribeToDataset x -> SubscribeToDataset
forall x. SubscribeToDataset -> Rep SubscribeToDataset x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SubscribeToDataset x -> SubscribeToDataset
$cfrom :: forall x. SubscribeToDataset -> Rep SubscribeToDataset x
Prelude.Generic)

-- |
-- Create a value of 'SubscribeToDataset' 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:
--
-- 'identityPoolId', 'subscribeToDataset_identityPoolId' - A name-spaced GUID (for example,
-- us-east-1:23EC4050-6AEA-7089-A2DD-08002EXAMPLE) created by Amazon
-- Cognito. The ID of the pool to which the identity belongs.
--
-- 'identityId', 'subscribeToDataset_identityId' - Unique ID for this identity.
--
-- 'datasetName', 'subscribeToDataset_datasetName' - The name of the dataset to subcribe to.
--
-- 'deviceId', 'subscribeToDataset_deviceId' - The unique ID generated for this device by Cognito.
newSubscribeToDataset ::
  -- | 'identityPoolId'
  Prelude.Text ->
  -- | 'identityId'
  Prelude.Text ->
  -- | 'datasetName'
  Prelude.Text ->
  -- | 'deviceId'
  Prelude.Text ->
  SubscribeToDataset
newSubscribeToDataset :: Text -> Text -> Text -> Text -> SubscribeToDataset
newSubscribeToDataset
  Text
pIdentityPoolId_
  Text
pIdentityId_
  Text
pDatasetName_
  Text
pDeviceId_ =
    SubscribeToDataset'
      { $sel:identityPoolId:SubscribeToDataset' :: Text
identityPoolId =
          Text
pIdentityPoolId_,
        $sel:identityId:SubscribeToDataset' :: Text
identityId = Text
pIdentityId_,
        $sel:datasetName:SubscribeToDataset' :: Text
datasetName = Text
pDatasetName_,
        $sel:deviceId:SubscribeToDataset' :: Text
deviceId = Text
pDeviceId_
      }

-- | A name-spaced GUID (for example,
-- us-east-1:23EC4050-6AEA-7089-A2DD-08002EXAMPLE) created by Amazon
-- Cognito. The ID of the pool to which the identity belongs.
subscribeToDataset_identityPoolId :: Lens.Lens' SubscribeToDataset Prelude.Text
subscribeToDataset_identityPoolId :: Lens' SubscribeToDataset Text
subscribeToDataset_identityPoolId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SubscribeToDataset' {Text
identityPoolId :: Text
$sel:identityPoolId:SubscribeToDataset' :: SubscribeToDataset -> Text
identityPoolId} -> Text
identityPoolId) (\s :: SubscribeToDataset
s@SubscribeToDataset' {} Text
a -> SubscribeToDataset
s {$sel:identityPoolId:SubscribeToDataset' :: Text
identityPoolId = Text
a} :: SubscribeToDataset)

-- | Unique ID for this identity.
subscribeToDataset_identityId :: Lens.Lens' SubscribeToDataset Prelude.Text
subscribeToDataset_identityId :: Lens' SubscribeToDataset Text
subscribeToDataset_identityId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SubscribeToDataset' {Text
identityId :: Text
$sel:identityId:SubscribeToDataset' :: SubscribeToDataset -> Text
identityId} -> Text
identityId) (\s :: SubscribeToDataset
s@SubscribeToDataset' {} Text
a -> SubscribeToDataset
s {$sel:identityId:SubscribeToDataset' :: Text
identityId = Text
a} :: SubscribeToDataset)

-- | The name of the dataset to subcribe to.
subscribeToDataset_datasetName :: Lens.Lens' SubscribeToDataset Prelude.Text
subscribeToDataset_datasetName :: Lens' SubscribeToDataset Text
subscribeToDataset_datasetName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SubscribeToDataset' {Text
datasetName :: Text
$sel:datasetName:SubscribeToDataset' :: SubscribeToDataset -> Text
datasetName} -> Text
datasetName) (\s :: SubscribeToDataset
s@SubscribeToDataset' {} Text
a -> SubscribeToDataset
s {$sel:datasetName:SubscribeToDataset' :: Text
datasetName = Text
a} :: SubscribeToDataset)

-- | The unique ID generated for this device by Cognito.
subscribeToDataset_deviceId :: Lens.Lens' SubscribeToDataset Prelude.Text
subscribeToDataset_deviceId :: Lens' SubscribeToDataset Text
subscribeToDataset_deviceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SubscribeToDataset' {Text
deviceId :: Text
$sel:deviceId:SubscribeToDataset' :: SubscribeToDataset -> Text
deviceId} -> Text
deviceId) (\s :: SubscribeToDataset
s@SubscribeToDataset' {} Text
a -> SubscribeToDataset
s {$sel:deviceId:SubscribeToDataset' :: Text
deviceId = Text
a} :: SubscribeToDataset)

instance Core.AWSRequest SubscribeToDataset where
  type
    AWSResponse SubscribeToDataset =
      SubscribeToDatasetResponse
  request :: (Service -> Service)
-> SubscribeToDataset -> Request SubscribeToDataset
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 SubscribeToDataset
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse SubscribeToDataset)))
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 -> SubscribeToDatasetResponse
SubscribeToDatasetResponse'
            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 SubscribeToDataset where
  hashWithSalt :: Int -> SubscribeToDataset -> Int
hashWithSalt Int
_salt SubscribeToDataset' {Text
deviceId :: Text
datasetName :: Text
identityId :: Text
identityPoolId :: Text
$sel:deviceId:SubscribeToDataset' :: SubscribeToDataset -> Text
$sel:datasetName:SubscribeToDataset' :: SubscribeToDataset -> Text
$sel:identityId:SubscribeToDataset' :: SubscribeToDataset -> Text
$sel:identityPoolId:SubscribeToDataset' :: SubscribeToDataset -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
identityPoolId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
identityId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
datasetName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
deviceId

instance Prelude.NFData SubscribeToDataset where
  rnf :: SubscribeToDataset -> ()
rnf SubscribeToDataset' {Text
deviceId :: Text
datasetName :: Text
identityId :: Text
identityPoolId :: Text
$sel:deviceId:SubscribeToDataset' :: SubscribeToDataset -> Text
$sel:datasetName:SubscribeToDataset' :: SubscribeToDataset -> Text
$sel:identityId:SubscribeToDataset' :: SubscribeToDataset -> Text
$sel:identityPoolId:SubscribeToDataset' :: SubscribeToDataset -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
identityPoolId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
identityId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
datasetName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
deviceId

instance Data.ToHeaders SubscribeToDataset where
  toHeaders :: SubscribeToDataset -> 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 SubscribeToDataset where
  toJSON :: SubscribeToDataset -> Value
toJSON = forall a b. a -> b -> a
Prelude.const (Object -> Value
Data.Object forall a. Monoid a => a
Prelude.mempty)

instance Data.ToPath SubscribeToDataset where
  toPath :: SubscribeToDataset -> ByteString
toPath SubscribeToDataset' {Text
deviceId :: Text
datasetName :: Text
identityId :: Text
identityPoolId :: Text
$sel:deviceId:SubscribeToDataset' :: SubscribeToDataset -> Text
$sel:datasetName:SubscribeToDataset' :: SubscribeToDataset -> Text
$sel:identityId:SubscribeToDataset' :: SubscribeToDataset -> Text
$sel:identityPoolId:SubscribeToDataset' :: SubscribeToDataset -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/identitypools/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
identityPoolId,
        ByteString
"/identities/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
identityId,
        ByteString
"/datasets/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
datasetName,
        ByteString
"/subscriptions/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
deviceId
      ]

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

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

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

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

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