{-# 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.GetWorkingLocation
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- A temporary Amazon S3 location, where you can copy your files from a
-- source location to stage or use as a scratch space in FinSpace notebook.
module Amazonka.FinSpaceData.GetWorkingLocation
  ( -- * Creating a Request
    GetWorkingLocation (..),
    newGetWorkingLocation,

    -- * Request Lenses
    getWorkingLocation_locationType,

    -- * Destructuring the Response
    GetWorkingLocationResponse (..),
    newGetWorkingLocationResponse,

    -- * Response Lenses
    getWorkingLocationResponse_s3Bucket,
    getWorkingLocationResponse_s3Path,
    getWorkingLocationResponse_s3Uri,
    getWorkingLocationResponse_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:/ 'newGetWorkingLocation' smart constructor.
data GetWorkingLocation = GetWorkingLocation'
  { -- | Specify the type of the working location.
    --
    -- -   @SAGEMAKER@ – Use the Amazon S3 location as a temporary location to
    --     store data content when working with FinSpace Notebooks that run on
    --     SageMaker studio.
    --
    -- -   @INGESTION@ – Use the Amazon S3 location as a staging location to
    --     copy your data content and then use the location with the Changeset
    --     creation operation.
    GetWorkingLocation -> Maybe LocationType
locationType :: Prelude.Maybe LocationType
  }
  deriving (GetWorkingLocation -> GetWorkingLocation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetWorkingLocation -> GetWorkingLocation -> Bool
$c/= :: GetWorkingLocation -> GetWorkingLocation -> Bool
== :: GetWorkingLocation -> GetWorkingLocation -> Bool
$c== :: GetWorkingLocation -> GetWorkingLocation -> Bool
Prelude.Eq, ReadPrec [GetWorkingLocation]
ReadPrec GetWorkingLocation
Int -> ReadS GetWorkingLocation
ReadS [GetWorkingLocation]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetWorkingLocation]
$creadListPrec :: ReadPrec [GetWorkingLocation]
readPrec :: ReadPrec GetWorkingLocation
$creadPrec :: ReadPrec GetWorkingLocation
readList :: ReadS [GetWorkingLocation]
$creadList :: ReadS [GetWorkingLocation]
readsPrec :: Int -> ReadS GetWorkingLocation
$creadsPrec :: Int -> ReadS GetWorkingLocation
Prelude.Read, Int -> GetWorkingLocation -> ShowS
[GetWorkingLocation] -> ShowS
GetWorkingLocation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetWorkingLocation] -> ShowS
$cshowList :: [GetWorkingLocation] -> ShowS
show :: GetWorkingLocation -> String
$cshow :: GetWorkingLocation -> String
showsPrec :: Int -> GetWorkingLocation -> ShowS
$cshowsPrec :: Int -> GetWorkingLocation -> ShowS
Prelude.Show, forall x. Rep GetWorkingLocation x -> GetWorkingLocation
forall x. GetWorkingLocation -> Rep GetWorkingLocation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetWorkingLocation x -> GetWorkingLocation
$cfrom :: forall x. GetWorkingLocation -> Rep GetWorkingLocation x
Prelude.Generic)

-- |
-- Create a value of 'GetWorkingLocation' 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:
--
-- 'locationType', 'getWorkingLocation_locationType' - Specify the type of the working location.
--
-- -   @SAGEMAKER@ – Use the Amazon S3 location as a temporary location to
--     store data content when working with FinSpace Notebooks that run on
--     SageMaker studio.
--
-- -   @INGESTION@ – Use the Amazon S3 location as a staging location to
--     copy your data content and then use the location with the Changeset
--     creation operation.
newGetWorkingLocation ::
  GetWorkingLocation
newGetWorkingLocation :: GetWorkingLocation
newGetWorkingLocation =
  GetWorkingLocation' {$sel:locationType:GetWorkingLocation' :: Maybe LocationType
locationType = forall a. Maybe a
Prelude.Nothing}

-- | Specify the type of the working location.
--
-- -   @SAGEMAKER@ – Use the Amazon S3 location as a temporary location to
--     store data content when working with FinSpace Notebooks that run on
--     SageMaker studio.
--
-- -   @INGESTION@ – Use the Amazon S3 location as a staging location to
--     copy your data content and then use the location with the Changeset
--     creation operation.
getWorkingLocation_locationType :: Lens.Lens' GetWorkingLocation (Prelude.Maybe LocationType)
getWorkingLocation_locationType :: Lens' GetWorkingLocation (Maybe LocationType)
getWorkingLocation_locationType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWorkingLocation' {Maybe LocationType
locationType :: Maybe LocationType
$sel:locationType:GetWorkingLocation' :: GetWorkingLocation -> Maybe LocationType
locationType} -> Maybe LocationType
locationType) (\s :: GetWorkingLocation
s@GetWorkingLocation' {} Maybe LocationType
a -> GetWorkingLocation
s {$sel:locationType:GetWorkingLocation' :: Maybe LocationType
locationType = Maybe LocationType
a} :: GetWorkingLocation)

instance Core.AWSRequest GetWorkingLocation where
  type
    AWSResponse GetWorkingLocation =
      GetWorkingLocationResponse
  request :: (Service -> Service)
-> GetWorkingLocation -> Request GetWorkingLocation
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 GetWorkingLocation
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetWorkingLocation)))
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
-> Maybe Text -> Maybe Text -> Int -> GetWorkingLocationResponse
GetWorkingLocationResponse'
            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
"s3Bucket")
            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
"s3Path")
            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
"s3Uri")
            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 GetWorkingLocation where
  hashWithSalt :: Int -> GetWorkingLocation -> Int
hashWithSalt Int
_salt GetWorkingLocation' {Maybe LocationType
locationType :: Maybe LocationType
$sel:locationType:GetWorkingLocation' :: GetWorkingLocation -> Maybe LocationType
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe LocationType
locationType

instance Prelude.NFData GetWorkingLocation where
  rnf :: GetWorkingLocation -> ()
rnf GetWorkingLocation' {Maybe LocationType
locationType :: Maybe LocationType
$sel:locationType:GetWorkingLocation' :: GetWorkingLocation -> Maybe LocationType
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe LocationType
locationType

instance Data.ToHeaders GetWorkingLocation where
  toHeaders :: GetWorkingLocation -> 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 GetWorkingLocation where
  toJSON :: GetWorkingLocation -> Value
toJSON GetWorkingLocation' {Maybe LocationType
locationType :: Maybe LocationType
$sel:locationType:GetWorkingLocation' :: GetWorkingLocation -> Maybe LocationType
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [(Key
"locationType" 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 LocationType
locationType]
      )

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

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

-- | /See:/ 'newGetWorkingLocationResponse' smart constructor.
data GetWorkingLocationResponse = GetWorkingLocationResponse'
  { -- | Returns the Amazon S3 bucket name for the working location.
    GetWorkingLocationResponse -> Maybe Text
s3Bucket :: Prelude.Maybe Prelude.Text,
    -- | Returns the Amazon S3 Path for the working location.
    GetWorkingLocationResponse -> Maybe Text
s3Path :: Prelude.Maybe Prelude.Text,
    -- | Returns the Amazon S3 URI for the working location.
    GetWorkingLocationResponse -> Maybe Text
s3Uri :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetWorkingLocationResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetWorkingLocationResponse -> GetWorkingLocationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetWorkingLocationResponse -> GetWorkingLocationResponse -> Bool
$c/= :: GetWorkingLocationResponse -> GetWorkingLocationResponse -> Bool
== :: GetWorkingLocationResponse -> GetWorkingLocationResponse -> Bool
$c== :: GetWorkingLocationResponse -> GetWorkingLocationResponse -> Bool
Prelude.Eq, ReadPrec [GetWorkingLocationResponse]
ReadPrec GetWorkingLocationResponse
Int -> ReadS GetWorkingLocationResponse
ReadS [GetWorkingLocationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetWorkingLocationResponse]
$creadListPrec :: ReadPrec [GetWorkingLocationResponse]
readPrec :: ReadPrec GetWorkingLocationResponse
$creadPrec :: ReadPrec GetWorkingLocationResponse
readList :: ReadS [GetWorkingLocationResponse]
$creadList :: ReadS [GetWorkingLocationResponse]
readsPrec :: Int -> ReadS GetWorkingLocationResponse
$creadsPrec :: Int -> ReadS GetWorkingLocationResponse
Prelude.Read, Int -> GetWorkingLocationResponse -> ShowS
[GetWorkingLocationResponse] -> ShowS
GetWorkingLocationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetWorkingLocationResponse] -> ShowS
$cshowList :: [GetWorkingLocationResponse] -> ShowS
show :: GetWorkingLocationResponse -> String
$cshow :: GetWorkingLocationResponse -> String
showsPrec :: Int -> GetWorkingLocationResponse -> ShowS
$cshowsPrec :: Int -> GetWorkingLocationResponse -> ShowS
Prelude.Show, forall x.
Rep GetWorkingLocationResponse x -> GetWorkingLocationResponse
forall x.
GetWorkingLocationResponse -> Rep GetWorkingLocationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetWorkingLocationResponse x -> GetWorkingLocationResponse
$cfrom :: forall x.
GetWorkingLocationResponse -> Rep GetWorkingLocationResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetWorkingLocationResponse' 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:
--
-- 's3Bucket', 'getWorkingLocationResponse_s3Bucket' - Returns the Amazon S3 bucket name for the working location.
--
-- 's3Path', 'getWorkingLocationResponse_s3Path' - Returns the Amazon S3 Path for the working location.
--
-- 's3Uri', 'getWorkingLocationResponse_s3Uri' - Returns the Amazon S3 URI for the working location.
--
-- 'httpStatus', 'getWorkingLocationResponse_httpStatus' - The response's http status code.
newGetWorkingLocationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetWorkingLocationResponse
newGetWorkingLocationResponse :: Int -> GetWorkingLocationResponse
newGetWorkingLocationResponse Int
pHttpStatus_ =
  GetWorkingLocationResponse'
    { $sel:s3Bucket:GetWorkingLocationResponse' :: Maybe Text
s3Bucket =
        forall a. Maybe a
Prelude.Nothing,
      $sel:s3Path:GetWorkingLocationResponse' :: Maybe Text
s3Path = forall a. Maybe a
Prelude.Nothing,
      $sel:s3Uri:GetWorkingLocationResponse' :: Maybe Text
s3Uri = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetWorkingLocationResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Returns the Amazon S3 bucket name for the working location.
getWorkingLocationResponse_s3Bucket :: Lens.Lens' GetWorkingLocationResponse (Prelude.Maybe Prelude.Text)
getWorkingLocationResponse_s3Bucket :: Lens' GetWorkingLocationResponse (Maybe Text)
getWorkingLocationResponse_s3Bucket = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWorkingLocationResponse' {Maybe Text
s3Bucket :: Maybe Text
$sel:s3Bucket:GetWorkingLocationResponse' :: GetWorkingLocationResponse -> Maybe Text
s3Bucket} -> Maybe Text
s3Bucket) (\s :: GetWorkingLocationResponse
s@GetWorkingLocationResponse' {} Maybe Text
a -> GetWorkingLocationResponse
s {$sel:s3Bucket:GetWorkingLocationResponse' :: Maybe Text
s3Bucket = Maybe Text
a} :: GetWorkingLocationResponse)

-- | Returns the Amazon S3 Path for the working location.
getWorkingLocationResponse_s3Path :: Lens.Lens' GetWorkingLocationResponse (Prelude.Maybe Prelude.Text)
getWorkingLocationResponse_s3Path :: Lens' GetWorkingLocationResponse (Maybe Text)
getWorkingLocationResponse_s3Path = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWorkingLocationResponse' {Maybe Text
s3Path :: Maybe Text
$sel:s3Path:GetWorkingLocationResponse' :: GetWorkingLocationResponse -> Maybe Text
s3Path} -> Maybe Text
s3Path) (\s :: GetWorkingLocationResponse
s@GetWorkingLocationResponse' {} Maybe Text
a -> GetWorkingLocationResponse
s {$sel:s3Path:GetWorkingLocationResponse' :: Maybe Text
s3Path = Maybe Text
a} :: GetWorkingLocationResponse)

-- | Returns the Amazon S3 URI for the working location.
getWorkingLocationResponse_s3Uri :: Lens.Lens' GetWorkingLocationResponse (Prelude.Maybe Prelude.Text)
getWorkingLocationResponse_s3Uri :: Lens' GetWorkingLocationResponse (Maybe Text)
getWorkingLocationResponse_s3Uri = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWorkingLocationResponse' {Maybe Text
s3Uri :: Maybe Text
$sel:s3Uri:GetWorkingLocationResponse' :: GetWorkingLocationResponse -> Maybe Text
s3Uri} -> Maybe Text
s3Uri) (\s :: GetWorkingLocationResponse
s@GetWorkingLocationResponse' {} Maybe Text
a -> GetWorkingLocationResponse
s {$sel:s3Uri:GetWorkingLocationResponse' :: Maybe Text
s3Uri = Maybe Text
a} :: GetWorkingLocationResponse)

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

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