{-# 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.FinSpaceData.GetExternalDataViewAccessDetails
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns the credentials to access the external Dataview from an S3
-- location. To call this API:
--
-- -   You must retrieve the programmatic credentials.
--
-- -   You must be a member of a FinSpace user group, where the dataset
--     that you want to access has @Read Dataset Data@ permissions.
module Amazonka.FinSpaceData.GetExternalDataViewAccessDetails
  ( -- * Creating a Request
    GetExternalDataViewAccessDetails (..),
    newGetExternalDataViewAccessDetails,

    -- * Request Lenses
    getExternalDataViewAccessDetails_dataViewId,
    getExternalDataViewAccessDetails_datasetId,

    -- * Destructuring the Response
    GetExternalDataViewAccessDetailsResponse (..),
    newGetExternalDataViewAccessDetailsResponse,

    -- * Response Lenses
    getExternalDataViewAccessDetailsResponse_credentials,
    getExternalDataViewAccessDetailsResponse_s3Location,
    getExternalDataViewAccessDetailsResponse_httpStatus,
  )
where

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

-- | /See:/ 'newGetExternalDataViewAccessDetails' smart constructor.
data GetExternalDataViewAccessDetails = GetExternalDataViewAccessDetails'
  { -- | The unique identifier for the Dataview that you want to access.
    GetExternalDataViewAccessDetails -> Text
dataViewId :: Prelude.Text,
    -- | The unique identifier for the Dataset.
    GetExternalDataViewAccessDetails -> Text
datasetId :: Prelude.Text
  }
  deriving (GetExternalDataViewAccessDetails
-> GetExternalDataViewAccessDetails -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetExternalDataViewAccessDetails
-> GetExternalDataViewAccessDetails -> Bool
$c/= :: GetExternalDataViewAccessDetails
-> GetExternalDataViewAccessDetails -> Bool
== :: GetExternalDataViewAccessDetails
-> GetExternalDataViewAccessDetails -> Bool
$c== :: GetExternalDataViewAccessDetails
-> GetExternalDataViewAccessDetails -> Bool
Prelude.Eq, ReadPrec [GetExternalDataViewAccessDetails]
ReadPrec GetExternalDataViewAccessDetails
Int -> ReadS GetExternalDataViewAccessDetails
ReadS [GetExternalDataViewAccessDetails]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetExternalDataViewAccessDetails]
$creadListPrec :: ReadPrec [GetExternalDataViewAccessDetails]
readPrec :: ReadPrec GetExternalDataViewAccessDetails
$creadPrec :: ReadPrec GetExternalDataViewAccessDetails
readList :: ReadS [GetExternalDataViewAccessDetails]
$creadList :: ReadS [GetExternalDataViewAccessDetails]
readsPrec :: Int -> ReadS GetExternalDataViewAccessDetails
$creadsPrec :: Int -> ReadS GetExternalDataViewAccessDetails
Prelude.Read, Int -> GetExternalDataViewAccessDetails -> ShowS
[GetExternalDataViewAccessDetails] -> ShowS
GetExternalDataViewAccessDetails -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetExternalDataViewAccessDetails] -> ShowS
$cshowList :: [GetExternalDataViewAccessDetails] -> ShowS
show :: GetExternalDataViewAccessDetails -> String
$cshow :: GetExternalDataViewAccessDetails -> String
showsPrec :: Int -> GetExternalDataViewAccessDetails -> ShowS
$cshowsPrec :: Int -> GetExternalDataViewAccessDetails -> ShowS
Prelude.Show, forall x.
Rep GetExternalDataViewAccessDetails x
-> GetExternalDataViewAccessDetails
forall x.
GetExternalDataViewAccessDetails
-> Rep GetExternalDataViewAccessDetails x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetExternalDataViewAccessDetails x
-> GetExternalDataViewAccessDetails
$cfrom :: forall x.
GetExternalDataViewAccessDetails
-> Rep GetExternalDataViewAccessDetails x
Prelude.Generic)

-- |
-- Create a value of 'GetExternalDataViewAccessDetails' 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:
--
-- 'dataViewId', 'getExternalDataViewAccessDetails_dataViewId' - The unique identifier for the Dataview that you want to access.
--
-- 'datasetId', 'getExternalDataViewAccessDetails_datasetId' - The unique identifier for the Dataset.
newGetExternalDataViewAccessDetails ::
  -- | 'dataViewId'
  Prelude.Text ->
  -- | 'datasetId'
  Prelude.Text ->
  GetExternalDataViewAccessDetails
newGetExternalDataViewAccessDetails :: Text -> Text -> GetExternalDataViewAccessDetails
newGetExternalDataViewAccessDetails
  Text
pDataViewId_
  Text
pDatasetId_ =
    GetExternalDataViewAccessDetails'
      { $sel:dataViewId:GetExternalDataViewAccessDetails' :: Text
dataViewId =
          Text
pDataViewId_,
        $sel:datasetId:GetExternalDataViewAccessDetails' :: Text
datasetId = Text
pDatasetId_
      }

-- | The unique identifier for the Dataview that you want to access.
getExternalDataViewAccessDetails_dataViewId :: Lens.Lens' GetExternalDataViewAccessDetails Prelude.Text
getExternalDataViewAccessDetails_dataViewId :: Lens' GetExternalDataViewAccessDetails Text
getExternalDataViewAccessDetails_dataViewId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetExternalDataViewAccessDetails' {Text
dataViewId :: Text
$sel:dataViewId:GetExternalDataViewAccessDetails' :: GetExternalDataViewAccessDetails -> Text
dataViewId} -> Text
dataViewId) (\s :: GetExternalDataViewAccessDetails
s@GetExternalDataViewAccessDetails' {} Text
a -> GetExternalDataViewAccessDetails
s {$sel:dataViewId:GetExternalDataViewAccessDetails' :: Text
dataViewId = Text
a} :: GetExternalDataViewAccessDetails)

-- | The unique identifier for the Dataset.
getExternalDataViewAccessDetails_datasetId :: Lens.Lens' GetExternalDataViewAccessDetails Prelude.Text
getExternalDataViewAccessDetails_datasetId :: Lens' GetExternalDataViewAccessDetails Text
getExternalDataViewAccessDetails_datasetId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetExternalDataViewAccessDetails' {Text
datasetId :: Text
$sel:datasetId:GetExternalDataViewAccessDetails' :: GetExternalDataViewAccessDetails -> Text
datasetId} -> Text
datasetId) (\s :: GetExternalDataViewAccessDetails
s@GetExternalDataViewAccessDetails' {} Text
a -> GetExternalDataViewAccessDetails
s {$sel:datasetId:GetExternalDataViewAccessDetails' :: Text
datasetId = Text
a} :: GetExternalDataViewAccessDetails)

instance
  Core.AWSRequest
    GetExternalDataViewAccessDetails
  where
  type
    AWSResponse GetExternalDataViewAccessDetails =
      GetExternalDataViewAccessDetailsResponse
  request :: (Service -> Service)
-> GetExternalDataViewAccessDetails
-> Request GetExternalDataViewAccessDetails
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 GetExternalDataViewAccessDetails
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse GetExternalDataViewAccessDetails)))
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 AwsCredentials
-> Maybe S3Location
-> Int
-> GetExternalDataViewAccessDetailsResponse
GetExternalDataViewAccessDetailsResponse'
            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
"credentials")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"s3Location")
            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
    GetExternalDataViewAccessDetails
  where
  hashWithSalt :: Int -> GetExternalDataViewAccessDetails -> Int
hashWithSalt
    Int
_salt
    GetExternalDataViewAccessDetails' {Text
datasetId :: Text
dataViewId :: Text
$sel:datasetId:GetExternalDataViewAccessDetails' :: GetExternalDataViewAccessDetails -> Text
$sel:dataViewId:GetExternalDataViewAccessDetails' :: GetExternalDataViewAccessDetails -> Text
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
dataViewId
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
datasetId

instance
  Prelude.NFData
    GetExternalDataViewAccessDetails
  where
  rnf :: GetExternalDataViewAccessDetails -> ()
rnf GetExternalDataViewAccessDetails' {Text
datasetId :: Text
dataViewId :: Text
$sel:datasetId:GetExternalDataViewAccessDetails' :: GetExternalDataViewAccessDetails -> Text
$sel:dataViewId:GetExternalDataViewAccessDetails' :: GetExternalDataViewAccessDetails -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
dataViewId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
datasetId

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

instance Data.ToPath GetExternalDataViewAccessDetails where
  toPath :: GetExternalDataViewAccessDetails -> ByteString
toPath GetExternalDataViewAccessDetails' {Text
datasetId :: Text
dataViewId :: Text
$sel:datasetId:GetExternalDataViewAccessDetails' :: GetExternalDataViewAccessDetails -> Text
$sel:dataViewId:GetExternalDataViewAccessDetails' :: GetExternalDataViewAccessDetails -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/datasets/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
datasetId,
        ByteString
"/dataviewsv2/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
dataViewId,
        ByteString
"/external-access-details"
      ]

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

-- | /See:/ 'newGetExternalDataViewAccessDetailsResponse' smart constructor.
data GetExternalDataViewAccessDetailsResponse = GetExternalDataViewAccessDetailsResponse'
  { -- | The credentials required to access the external Dataview from the S3
    -- location.
    GetExternalDataViewAccessDetailsResponse -> Maybe AwsCredentials
credentials :: Prelude.Maybe AwsCredentials,
    -- | The location where the external Dataview is stored.
    GetExternalDataViewAccessDetailsResponse -> Maybe S3Location
s3Location :: Prelude.Maybe S3Location,
    -- | The response's http status code.
    GetExternalDataViewAccessDetailsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetExternalDataViewAccessDetailsResponse
-> GetExternalDataViewAccessDetailsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetExternalDataViewAccessDetailsResponse
-> GetExternalDataViewAccessDetailsResponse -> Bool
$c/= :: GetExternalDataViewAccessDetailsResponse
-> GetExternalDataViewAccessDetailsResponse -> Bool
== :: GetExternalDataViewAccessDetailsResponse
-> GetExternalDataViewAccessDetailsResponse -> Bool
$c== :: GetExternalDataViewAccessDetailsResponse
-> GetExternalDataViewAccessDetailsResponse -> Bool
Prelude.Eq, Int -> GetExternalDataViewAccessDetailsResponse -> ShowS
[GetExternalDataViewAccessDetailsResponse] -> ShowS
GetExternalDataViewAccessDetailsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetExternalDataViewAccessDetailsResponse] -> ShowS
$cshowList :: [GetExternalDataViewAccessDetailsResponse] -> ShowS
show :: GetExternalDataViewAccessDetailsResponse -> String
$cshow :: GetExternalDataViewAccessDetailsResponse -> String
showsPrec :: Int -> GetExternalDataViewAccessDetailsResponse -> ShowS
$cshowsPrec :: Int -> GetExternalDataViewAccessDetailsResponse -> ShowS
Prelude.Show, forall x.
Rep GetExternalDataViewAccessDetailsResponse x
-> GetExternalDataViewAccessDetailsResponse
forall x.
GetExternalDataViewAccessDetailsResponse
-> Rep GetExternalDataViewAccessDetailsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetExternalDataViewAccessDetailsResponse x
-> GetExternalDataViewAccessDetailsResponse
$cfrom :: forall x.
GetExternalDataViewAccessDetailsResponse
-> Rep GetExternalDataViewAccessDetailsResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetExternalDataViewAccessDetailsResponse' 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:
--
-- 'credentials', 'getExternalDataViewAccessDetailsResponse_credentials' - The credentials required to access the external Dataview from the S3
-- location.
--
-- 's3Location', 'getExternalDataViewAccessDetailsResponse_s3Location' - The location where the external Dataview is stored.
--
-- 'httpStatus', 'getExternalDataViewAccessDetailsResponse_httpStatus' - The response's http status code.
newGetExternalDataViewAccessDetailsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetExternalDataViewAccessDetailsResponse
newGetExternalDataViewAccessDetailsResponse :: Int -> GetExternalDataViewAccessDetailsResponse
newGetExternalDataViewAccessDetailsResponse
  Int
pHttpStatus_ =
    GetExternalDataViewAccessDetailsResponse'
      { $sel:credentials:GetExternalDataViewAccessDetailsResponse' :: Maybe AwsCredentials
credentials =
          forall a. Maybe a
Prelude.Nothing,
        $sel:s3Location:GetExternalDataViewAccessDetailsResponse' :: Maybe S3Location
s3Location = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:GetExternalDataViewAccessDetailsResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | The credentials required to access the external Dataview from the S3
-- location.
getExternalDataViewAccessDetailsResponse_credentials :: Lens.Lens' GetExternalDataViewAccessDetailsResponse (Prelude.Maybe AwsCredentials)
getExternalDataViewAccessDetailsResponse_credentials :: Lens'
  GetExternalDataViewAccessDetailsResponse (Maybe AwsCredentials)
getExternalDataViewAccessDetailsResponse_credentials = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetExternalDataViewAccessDetailsResponse' {Maybe AwsCredentials
credentials :: Maybe AwsCredentials
$sel:credentials:GetExternalDataViewAccessDetailsResponse' :: GetExternalDataViewAccessDetailsResponse -> Maybe AwsCredentials
credentials} -> Maybe AwsCredentials
credentials) (\s :: GetExternalDataViewAccessDetailsResponse
s@GetExternalDataViewAccessDetailsResponse' {} Maybe AwsCredentials
a -> GetExternalDataViewAccessDetailsResponse
s {$sel:credentials:GetExternalDataViewAccessDetailsResponse' :: Maybe AwsCredentials
credentials = Maybe AwsCredentials
a} :: GetExternalDataViewAccessDetailsResponse)

-- | The location where the external Dataview is stored.
getExternalDataViewAccessDetailsResponse_s3Location :: Lens.Lens' GetExternalDataViewAccessDetailsResponse (Prelude.Maybe S3Location)
getExternalDataViewAccessDetailsResponse_s3Location :: Lens' GetExternalDataViewAccessDetailsResponse (Maybe S3Location)
getExternalDataViewAccessDetailsResponse_s3Location = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetExternalDataViewAccessDetailsResponse' {Maybe S3Location
s3Location :: Maybe S3Location
$sel:s3Location:GetExternalDataViewAccessDetailsResponse' :: GetExternalDataViewAccessDetailsResponse -> Maybe S3Location
s3Location} -> Maybe S3Location
s3Location) (\s :: GetExternalDataViewAccessDetailsResponse
s@GetExternalDataViewAccessDetailsResponse' {} Maybe S3Location
a -> GetExternalDataViewAccessDetailsResponse
s {$sel:s3Location:GetExternalDataViewAccessDetailsResponse' :: Maybe S3Location
s3Location = Maybe S3Location
a} :: GetExternalDataViewAccessDetailsResponse)

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

instance
  Prelude.NFData
    GetExternalDataViewAccessDetailsResponse
  where
  rnf :: GetExternalDataViewAccessDetailsResponse -> ()
rnf GetExternalDataViewAccessDetailsResponse' {Int
Maybe AwsCredentials
Maybe S3Location
httpStatus :: Int
s3Location :: Maybe S3Location
credentials :: Maybe AwsCredentials
$sel:httpStatus:GetExternalDataViewAccessDetailsResponse' :: GetExternalDataViewAccessDetailsResponse -> Int
$sel:s3Location:GetExternalDataViewAccessDetailsResponse' :: GetExternalDataViewAccessDetailsResponse -> Maybe S3Location
$sel:credentials:GetExternalDataViewAccessDetailsResponse' :: GetExternalDataViewAccessDetailsResponse -> Maybe AwsCredentials
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AwsCredentials
credentials
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe S3Location
s3Location
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus