{-# 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.KinesisVideo.GetDataEndpoint
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets an endpoint for a specified stream for either reading or writing.
-- Use this endpoint in your application to read from the specified stream
-- (using the @GetMedia@ or @GetMediaForFragmentList@ operations) or write
-- to it (using the @PutMedia@ operation).
--
-- The returned endpoint does not have the API name appended. The client
-- needs to add the API name to the returned endpoint.
--
-- In the request, specify the stream either by @StreamName@ or
-- @StreamARN@.
module Amazonka.KinesisVideo.GetDataEndpoint
  ( -- * Creating a Request
    GetDataEndpoint (..),
    newGetDataEndpoint,

    -- * Request Lenses
    getDataEndpoint_streamARN,
    getDataEndpoint_streamName,
    getDataEndpoint_aPIName,

    -- * Destructuring the Response
    GetDataEndpointResponse (..),
    newGetDataEndpointResponse,

    -- * Response Lenses
    getDataEndpointResponse_dataEndpoint,
    getDataEndpointResponse_httpStatus,
  )
where

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

-- | /See:/ 'newGetDataEndpoint' smart constructor.
data GetDataEndpoint = GetDataEndpoint'
  { -- | The Amazon Resource Name (ARN) of the stream that you want to get the
    -- endpoint for. You must specify either this parameter or a @StreamName@
    -- in the request.
    GetDataEndpoint -> Maybe Text
streamARN :: Prelude.Maybe Prelude.Text,
    -- | The name of the stream that you want to get the endpoint for. You must
    -- specify either this parameter or a @StreamARN@ in the request.
    GetDataEndpoint -> Maybe Text
streamName :: Prelude.Maybe Prelude.Text,
    -- | The name of the API action for which to get an endpoint.
    GetDataEndpoint -> APIName
aPIName :: APIName
  }
  deriving (GetDataEndpoint -> GetDataEndpoint -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetDataEndpoint -> GetDataEndpoint -> Bool
$c/= :: GetDataEndpoint -> GetDataEndpoint -> Bool
== :: GetDataEndpoint -> GetDataEndpoint -> Bool
$c== :: GetDataEndpoint -> GetDataEndpoint -> Bool
Prelude.Eq, ReadPrec [GetDataEndpoint]
ReadPrec GetDataEndpoint
Int -> ReadS GetDataEndpoint
ReadS [GetDataEndpoint]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetDataEndpoint]
$creadListPrec :: ReadPrec [GetDataEndpoint]
readPrec :: ReadPrec GetDataEndpoint
$creadPrec :: ReadPrec GetDataEndpoint
readList :: ReadS [GetDataEndpoint]
$creadList :: ReadS [GetDataEndpoint]
readsPrec :: Int -> ReadS GetDataEndpoint
$creadsPrec :: Int -> ReadS GetDataEndpoint
Prelude.Read, Int -> GetDataEndpoint -> ShowS
[GetDataEndpoint] -> ShowS
GetDataEndpoint -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetDataEndpoint] -> ShowS
$cshowList :: [GetDataEndpoint] -> ShowS
show :: GetDataEndpoint -> String
$cshow :: GetDataEndpoint -> String
showsPrec :: Int -> GetDataEndpoint -> ShowS
$cshowsPrec :: Int -> GetDataEndpoint -> ShowS
Prelude.Show, forall x. Rep GetDataEndpoint x -> GetDataEndpoint
forall x. GetDataEndpoint -> Rep GetDataEndpoint x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetDataEndpoint x -> GetDataEndpoint
$cfrom :: forall x. GetDataEndpoint -> Rep GetDataEndpoint x
Prelude.Generic)

-- |
-- Create a value of 'GetDataEndpoint' 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:
--
-- 'streamARN', 'getDataEndpoint_streamARN' - The Amazon Resource Name (ARN) of the stream that you want to get the
-- endpoint for. You must specify either this parameter or a @StreamName@
-- in the request.
--
-- 'streamName', 'getDataEndpoint_streamName' - The name of the stream that you want to get the endpoint for. You must
-- specify either this parameter or a @StreamARN@ in the request.
--
-- 'aPIName', 'getDataEndpoint_aPIName' - The name of the API action for which to get an endpoint.
newGetDataEndpoint ::
  -- | 'aPIName'
  APIName ->
  GetDataEndpoint
newGetDataEndpoint :: APIName -> GetDataEndpoint
newGetDataEndpoint APIName
pAPIName_ =
  GetDataEndpoint'
    { $sel:streamARN:GetDataEndpoint' :: Maybe Text
streamARN = forall a. Maybe a
Prelude.Nothing,
      $sel:streamName:GetDataEndpoint' :: Maybe Text
streamName = forall a. Maybe a
Prelude.Nothing,
      $sel:aPIName:GetDataEndpoint' :: APIName
aPIName = APIName
pAPIName_
    }

-- | The Amazon Resource Name (ARN) of the stream that you want to get the
-- endpoint for. You must specify either this parameter or a @StreamName@
-- in the request.
getDataEndpoint_streamARN :: Lens.Lens' GetDataEndpoint (Prelude.Maybe Prelude.Text)
getDataEndpoint_streamARN :: Lens' GetDataEndpoint (Maybe Text)
getDataEndpoint_streamARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDataEndpoint' {Maybe Text
streamARN :: Maybe Text
$sel:streamARN:GetDataEndpoint' :: GetDataEndpoint -> Maybe Text
streamARN} -> Maybe Text
streamARN) (\s :: GetDataEndpoint
s@GetDataEndpoint' {} Maybe Text
a -> GetDataEndpoint
s {$sel:streamARN:GetDataEndpoint' :: Maybe Text
streamARN = Maybe Text
a} :: GetDataEndpoint)

-- | The name of the stream that you want to get the endpoint for. You must
-- specify either this parameter or a @StreamARN@ in the request.
getDataEndpoint_streamName :: Lens.Lens' GetDataEndpoint (Prelude.Maybe Prelude.Text)
getDataEndpoint_streamName :: Lens' GetDataEndpoint (Maybe Text)
getDataEndpoint_streamName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDataEndpoint' {Maybe Text
streamName :: Maybe Text
$sel:streamName:GetDataEndpoint' :: GetDataEndpoint -> Maybe Text
streamName} -> Maybe Text
streamName) (\s :: GetDataEndpoint
s@GetDataEndpoint' {} Maybe Text
a -> GetDataEndpoint
s {$sel:streamName:GetDataEndpoint' :: Maybe Text
streamName = Maybe Text
a} :: GetDataEndpoint)

-- | The name of the API action for which to get an endpoint.
getDataEndpoint_aPIName :: Lens.Lens' GetDataEndpoint APIName
getDataEndpoint_aPIName :: Lens' GetDataEndpoint APIName
getDataEndpoint_aPIName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDataEndpoint' {APIName
aPIName :: APIName
$sel:aPIName:GetDataEndpoint' :: GetDataEndpoint -> APIName
aPIName} -> APIName
aPIName) (\s :: GetDataEndpoint
s@GetDataEndpoint' {} APIName
a -> GetDataEndpoint
s {$sel:aPIName:GetDataEndpoint' :: APIName
aPIName = APIName
a} :: GetDataEndpoint)

instance Core.AWSRequest GetDataEndpoint where
  type
    AWSResponse GetDataEndpoint =
      GetDataEndpointResponse
  request :: (Service -> Service) -> GetDataEndpoint -> Request GetDataEndpoint
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 GetDataEndpoint
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetDataEndpoint)))
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 -> GetDataEndpointResponse
GetDataEndpointResponse'
            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
"DataEndpoint")
            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 GetDataEndpoint where
  hashWithSalt :: Int -> GetDataEndpoint -> Int
hashWithSalt Int
_salt GetDataEndpoint' {Maybe Text
APIName
aPIName :: APIName
streamName :: Maybe Text
streamARN :: Maybe Text
$sel:aPIName:GetDataEndpoint' :: GetDataEndpoint -> APIName
$sel:streamName:GetDataEndpoint' :: GetDataEndpoint -> Maybe Text
$sel:streamARN:GetDataEndpoint' :: GetDataEndpoint -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
streamARN
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
streamName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` APIName
aPIName

instance Prelude.NFData GetDataEndpoint where
  rnf :: GetDataEndpoint -> ()
rnf GetDataEndpoint' {Maybe Text
APIName
aPIName :: APIName
streamName :: Maybe Text
streamARN :: Maybe Text
$sel:aPIName:GetDataEndpoint' :: GetDataEndpoint -> APIName
$sel:streamName:GetDataEndpoint' :: GetDataEndpoint -> Maybe Text
$sel:streamARN:GetDataEndpoint' :: GetDataEndpoint -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
streamARN
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
streamName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf APIName
aPIName

instance Data.ToHeaders GetDataEndpoint where
  toHeaders :: GetDataEndpoint -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToJSON GetDataEndpoint where
  toJSON :: GetDataEndpoint -> Value
toJSON GetDataEndpoint' {Maybe Text
APIName
aPIName :: APIName
streamName :: Maybe Text
streamARN :: Maybe Text
$sel:aPIName:GetDataEndpoint' :: GetDataEndpoint -> APIName
$sel:streamName:GetDataEndpoint' :: GetDataEndpoint -> Maybe Text
$sel:streamARN:GetDataEndpoint' :: GetDataEndpoint -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"StreamARN" 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
streamARN,
            (Key
"StreamName" 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
streamName,
            forall a. a -> Maybe a
Prelude.Just (Key
"APIName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= APIName
aPIName)
          ]
      )

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

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

-- | /See:/ 'newGetDataEndpointResponse' smart constructor.
data GetDataEndpointResponse = GetDataEndpointResponse'
  { -- | The endpoint value. To read data from the stream or to write data to it,
    -- specify this endpoint in your application.
    GetDataEndpointResponse -> Maybe Text
dataEndpoint :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetDataEndpointResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetDataEndpointResponse -> GetDataEndpointResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetDataEndpointResponse -> GetDataEndpointResponse -> Bool
$c/= :: GetDataEndpointResponse -> GetDataEndpointResponse -> Bool
== :: GetDataEndpointResponse -> GetDataEndpointResponse -> Bool
$c== :: GetDataEndpointResponse -> GetDataEndpointResponse -> Bool
Prelude.Eq, ReadPrec [GetDataEndpointResponse]
ReadPrec GetDataEndpointResponse
Int -> ReadS GetDataEndpointResponse
ReadS [GetDataEndpointResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetDataEndpointResponse]
$creadListPrec :: ReadPrec [GetDataEndpointResponse]
readPrec :: ReadPrec GetDataEndpointResponse
$creadPrec :: ReadPrec GetDataEndpointResponse
readList :: ReadS [GetDataEndpointResponse]
$creadList :: ReadS [GetDataEndpointResponse]
readsPrec :: Int -> ReadS GetDataEndpointResponse
$creadsPrec :: Int -> ReadS GetDataEndpointResponse
Prelude.Read, Int -> GetDataEndpointResponse -> ShowS
[GetDataEndpointResponse] -> ShowS
GetDataEndpointResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetDataEndpointResponse] -> ShowS
$cshowList :: [GetDataEndpointResponse] -> ShowS
show :: GetDataEndpointResponse -> String
$cshow :: GetDataEndpointResponse -> String
showsPrec :: Int -> GetDataEndpointResponse -> ShowS
$cshowsPrec :: Int -> GetDataEndpointResponse -> ShowS
Prelude.Show, forall x. Rep GetDataEndpointResponse x -> GetDataEndpointResponse
forall x. GetDataEndpointResponse -> Rep GetDataEndpointResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetDataEndpointResponse x -> GetDataEndpointResponse
$cfrom :: forall x. GetDataEndpointResponse -> Rep GetDataEndpointResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetDataEndpointResponse' 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:
--
-- 'dataEndpoint', 'getDataEndpointResponse_dataEndpoint' - The endpoint value. To read data from the stream or to write data to it,
-- specify this endpoint in your application.
--
-- 'httpStatus', 'getDataEndpointResponse_httpStatus' - The response's http status code.
newGetDataEndpointResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetDataEndpointResponse
newGetDataEndpointResponse :: Int -> GetDataEndpointResponse
newGetDataEndpointResponse Int
pHttpStatus_ =
  GetDataEndpointResponse'
    { $sel:dataEndpoint:GetDataEndpointResponse' :: Maybe Text
dataEndpoint =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetDataEndpointResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The endpoint value. To read data from the stream or to write data to it,
-- specify this endpoint in your application.
getDataEndpointResponse_dataEndpoint :: Lens.Lens' GetDataEndpointResponse (Prelude.Maybe Prelude.Text)
getDataEndpointResponse_dataEndpoint :: Lens' GetDataEndpointResponse (Maybe Text)
getDataEndpointResponse_dataEndpoint = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDataEndpointResponse' {Maybe Text
dataEndpoint :: Maybe Text
$sel:dataEndpoint:GetDataEndpointResponse' :: GetDataEndpointResponse -> Maybe Text
dataEndpoint} -> Maybe Text
dataEndpoint) (\s :: GetDataEndpointResponse
s@GetDataEndpointResponse' {} Maybe Text
a -> GetDataEndpointResponse
s {$sel:dataEndpoint:GetDataEndpointResponse' :: Maybe Text
dataEndpoint = Maybe Text
a} :: GetDataEndpointResponse)

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

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