{-# 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.Kinesis.SubscribeToShard
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- This operation establishes an HTTP\/2 connection between the consumer
-- you specify in the @ConsumerARN@ parameter and the shard you specify in
-- the @ShardId@ parameter. After the connection is successfully
-- established, Kinesis Data Streams pushes records from the shard to the
-- consumer over this connection. Before you call this operation, call
-- RegisterStreamConsumer to register the consumer with Kinesis Data
-- Streams.
--
-- When the @SubscribeToShard@ call succeeds, your consumer starts
-- receiving events of type SubscribeToShardEvent over the HTTP\/2
-- connection for up to 5 minutes, after which time you need to call
-- @SubscribeToShard@ again to renew the subscription if you want to
-- continue to receive records.
--
-- You can make one call to @SubscribeToShard@ per second per registered
-- consumer per shard. For example, if you have a 4000 shard stream and two
-- registered stream consumers, you can make one @SubscribeToShard@ request
-- per second for each combination of shard and registered consumer,
-- allowing you to subscribe both consumers to all 4000 shards in one
-- second.
--
-- If you call @SubscribeToShard@ again with the same @ConsumerARN@ and
-- @ShardId@ within 5 seconds of a successful call, you\'ll get a
-- @ResourceInUseException@. If you call @SubscribeToShard@ 5 seconds or
-- more after a successful call, the second call takes over the
-- subscription and the previous connection expires or fails with a
-- @ResourceInUseException@.
--
-- For an example of how to use this operations, see
-- </streams/latest/dev/building-enhanced-consumers-api.html Enhanced Fan-Out Using the Kinesis Data Streams API>.
module Amazonka.Kinesis.SubscribeToShard
  ( -- * Creating a Request
    SubscribeToShard (..),
    newSubscribeToShard,

    -- * Request Lenses
    subscribeToShard_consumerARN,
    subscribeToShard_shardId,
    subscribeToShard_startingPosition,

    -- * Destructuring the Response
    SubscribeToShardResponse (..),
    newSubscribeToShardResponse,

    -- * Response Lenses
    subscribeToShardResponse_httpStatus,
    subscribeToShardResponse_eventStream,
  )
where

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

-- | /See:/ 'newSubscribeToShard' smart constructor.
data SubscribeToShard = SubscribeToShard'
  { -- | For this parameter, use the value you obtained when you called
    -- RegisterStreamConsumer.
    SubscribeToShard -> Text
consumerARN :: Prelude.Text,
    -- | The ID of the shard you want to subscribe to. To see a list of all the
    -- shards for a given stream, use ListShards.
    SubscribeToShard -> Text
shardId :: Prelude.Text,
    -- | The starting position in the data stream from which to start streaming.
    SubscribeToShard -> StartingPosition
startingPosition :: StartingPosition
  }
  deriving (SubscribeToShard -> SubscribeToShard -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SubscribeToShard -> SubscribeToShard -> Bool
$c/= :: SubscribeToShard -> SubscribeToShard -> Bool
== :: SubscribeToShard -> SubscribeToShard -> Bool
$c== :: SubscribeToShard -> SubscribeToShard -> Bool
Prelude.Eq, ReadPrec [SubscribeToShard]
ReadPrec SubscribeToShard
Int -> ReadS SubscribeToShard
ReadS [SubscribeToShard]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SubscribeToShard]
$creadListPrec :: ReadPrec [SubscribeToShard]
readPrec :: ReadPrec SubscribeToShard
$creadPrec :: ReadPrec SubscribeToShard
readList :: ReadS [SubscribeToShard]
$creadList :: ReadS [SubscribeToShard]
readsPrec :: Int -> ReadS SubscribeToShard
$creadsPrec :: Int -> ReadS SubscribeToShard
Prelude.Read, Int -> SubscribeToShard -> ShowS
[SubscribeToShard] -> ShowS
SubscribeToShard -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SubscribeToShard] -> ShowS
$cshowList :: [SubscribeToShard] -> ShowS
show :: SubscribeToShard -> String
$cshow :: SubscribeToShard -> String
showsPrec :: Int -> SubscribeToShard -> ShowS
$cshowsPrec :: Int -> SubscribeToShard -> ShowS
Prelude.Show, forall x. Rep SubscribeToShard x -> SubscribeToShard
forall x. SubscribeToShard -> Rep SubscribeToShard x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SubscribeToShard x -> SubscribeToShard
$cfrom :: forall x. SubscribeToShard -> Rep SubscribeToShard x
Prelude.Generic)

-- |
-- Create a value of 'SubscribeToShard' 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:
--
-- 'consumerARN', 'subscribeToShard_consumerARN' - For this parameter, use the value you obtained when you called
-- RegisterStreamConsumer.
--
-- 'shardId', 'subscribeToShard_shardId' - The ID of the shard you want to subscribe to. To see a list of all the
-- shards for a given stream, use ListShards.
--
-- 'startingPosition', 'subscribeToShard_startingPosition' - The starting position in the data stream from which to start streaming.
newSubscribeToShard ::
  -- | 'consumerARN'
  Prelude.Text ->
  -- | 'shardId'
  Prelude.Text ->
  -- | 'startingPosition'
  StartingPosition ->
  SubscribeToShard
newSubscribeToShard :: Text -> Text -> StartingPosition -> SubscribeToShard
newSubscribeToShard
  Text
pConsumerARN_
  Text
pShardId_
  StartingPosition
pStartingPosition_ =
    SubscribeToShard'
      { $sel:consumerARN:SubscribeToShard' :: Text
consumerARN = Text
pConsumerARN_,
        $sel:shardId:SubscribeToShard' :: Text
shardId = Text
pShardId_,
        $sel:startingPosition:SubscribeToShard' :: StartingPosition
startingPosition = StartingPosition
pStartingPosition_
      }

-- | For this parameter, use the value you obtained when you called
-- RegisterStreamConsumer.
subscribeToShard_consumerARN :: Lens.Lens' SubscribeToShard Prelude.Text
subscribeToShard_consumerARN :: Lens' SubscribeToShard Text
subscribeToShard_consumerARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SubscribeToShard' {Text
consumerARN :: Text
$sel:consumerARN:SubscribeToShard' :: SubscribeToShard -> Text
consumerARN} -> Text
consumerARN) (\s :: SubscribeToShard
s@SubscribeToShard' {} Text
a -> SubscribeToShard
s {$sel:consumerARN:SubscribeToShard' :: Text
consumerARN = Text
a} :: SubscribeToShard)

-- | The ID of the shard you want to subscribe to. To see a list of all the
-- shards for a given stream, use ListShards.
subscribeToShard_shardId :: Lens.Lens' SubscribeToShard Prelude.Text
subscribeToShard_shardId :: Lens' SubscribeToShard Text
subscribeToShard_shardId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SubscribeToShard' {Text
shardId :: Text
$sel:shardId:SubscribeToShard' :: SubscribeToShard -> Text
shardId} -> Text
shardId) (\s :: SubscribeToShard
s@SubscribeToShard' {} Text
a -> SubscribeToShard
s {$sel:shardId:SubscribeToShard' :: Text
shardId = Text
a} :: SubscribeToShard)

-- | The starting position in the data stream from which to start streaming.
subscribeToShard_startingPosition :: Lens.Lens' SubscribeToShard StartingPosition
subscribeToShard_startingPosition :: Lens' SubscribeToShard StartingPosition
subscribeToShard_startingPosition = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SubscribeToShard' {StartingPosition
startingPosition :: StartingPosition
$sel:startingPosition:SubscribeToShard' :: SubscribeToShard -> StartingPosition
startingPosition} -> StartingPosition
startingPosition) (\s :: SubscribeToShard
s@SubscribeToShard' {} StartingPosition
a -> SubscribeToShard
s {$sel:startingPosition:SubscribeToShard' :: StartingPosition
startingPosition = StartingPosition
a} :: SubscribeToShard)

instance Core.AWSRequest SubscribeToShard where
  type
    AWSResponse SubscribeToShard =
      SubscribeToShardResponse
  request :: (Service -> Service)
-> SubscribeToShard -> Request SubscribeToShard
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 SubscribeToShard
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse SubscribeToShard)))
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 ->
          Int -> Value -> SubscribeToShardResponse
SubscribeToShardResponse'
            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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"EventStream")
      )

instance Prelude.Hashable SubscribeToShard where
  hashWithSalt :: Int -> SubscribeToShard -> Int
hashWithSalt Int
_salt SubscribeToShard' {Text
StartingPosition
startingPosition :: StartingPosition
shardId :: Text
consumerARN :: Text
$sel:startingPosition:SubscribeToShard' :: SubscribeToShard -> StartingPosition
$sel:shardId:SubscribeToShard' :: SubscribeToShard -> Text
$sel:consumerARN:SubscribeToShard' :: SubscribeToShard -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
consumerARN
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
shardId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` StartingPosition
startingPosition

instance Prelude.NFData SubscribeToShard where
  rnf :: SubscribeToShard -> ()
rnf SubscribeToShard' {Text
StartingPosition
startingPosition :: StartingPosition
shardId :: Text
consumerARN :: Text
$sel:startingPosition:SubscribeToShard' :: SubscribeToShard -> StartingPosition
$sel:shardId:SubscribeToShard' :: SubscribeToShard -> Text
$sel:consumerARN:SubscribeToShard' :: SubscribeToShard -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
consumerARN
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
shardId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf StartingPosition
startingPosition

instance Data.ToHeaders SubscribeToShard where
  toHeaders :: SubscribeToShard -> 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
"Kinesis_20131202.SubscribeToShard" ::
                          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 SubscribeToShard where
  toJSON :: SubscribeToShard -> Value
toJSON SubscribeToShard' {Text
StartingPosition
startingPosition :: StartingPosition
shardId :: Text
consumerARN :: Text
$sel:startingPosition:SubscribeToShard' :: SubscribeToShard -> StartingPosition
$sel:shardId:SubscribeToShard' :: SubscribeToShard -> Text
$sel:consumerARN:SubscribeToShard' :: SubscribeToShard -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"ConsumerARN" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
consumerARN),
            forall a. a -> Maybe a
Prelude.Just (Key
"ShardId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
shardId),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"StartingPosition" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= StartingPosition
startingPosition)
          ]
      )

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

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

-- | /See:/ 'newSubscribeToShardResponse' smart constructor.
data SubscribeToShardResponse = SubscribeToShardResponse'
  { -- | The response's http status code.
    SubscribeToShardResponse -> Int
httpStatus :: Prelude.Int,
    -- | The event stream that your consumer can use to read records from the
    -- shard.
    SubscribeToShardResponse -> Value
eventStream :: Data.Value
  }
  deriving (forall x.
Rep SubscribeToShardResponse x -> SubscribeToShardResponse
forall x.
SubscribeToShardResponse -> Rep SubscribeToShardResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep SubscribeToShardResponse x -> SubscribeToShardResponse
$cfrom :: forall x.
SubscribeToShardResponse -> Rep SubscribeToShardResponse x
Prelude.Generic)

-- |
-- Create a value of 'SubscribeToShardResponse' 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', 'subscribeToShardResponse_httpStatus' - The response's http status code.
--
-- 'eventStream', 'subscribeToShardResponse_eventStream' - The event stream that your consumer can use to read records from the
-- shard.
newSubscribeToShardResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'eventStream'
  Data.Value ->
  SubscribeToShardResponse
newSubscribeToShardResponse :: Int -> Value -> SubscribeToShardResponse
newSubscribeToShardResponse
  Int
pHttpStatus_
  Value
pEventStream_ =
    SubscribeToShardResponse'
      { $sel:httpStatus:SubscribeToShardResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:eventStream:SubscribeToShardResponse' :: Value
eventStream = Value
pEventStream_
      }

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

-- | The event stream that your consumer can use to read records from the
-- shard.
subscribeToShardResponse_eventStream :: Lens.Lens' SubscribeToShardResponse Data.Value
subscribeToShardResponse_eventStream :: Lens' SubscribeToShardResponse Value
subscribeToShardResponse_eventStream = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SubscribeToShardResponse' {Value
eventStream :: Value
$sel:eventStream:SubscribeToShardResponse' :: SubscribeToShardResponse -> Value
eventStream} -> Value
eventStream) (\s :: SubscribeToShardResponse
s@SubscribeToShardResponse' {} Value
a -> SubscribeToShardResponse
s {$sel:eventStream:SubscribeToShardResponse' :: Value
eventStream = Value
a} :: SubscribeToShardResponse)

instance Prelude.NFData SubscribeToShardResponse where
  rnf :: SubscribeToShardResponse -> ()
rnf SubscribeToShardResponse' {Int
Value
eventStream :: Value
httpStatus :: Int
$sel:eventStream:SubscribeToShardResponse' :: SubscribeToShardResponse -> Value
$sel:httpStatus:SubscribeToShardResponse' :: SubscribeToShardResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Value
eventStream