{-# 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.Glue.GetMapping
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates mappings.
module Amazonka.Glue.GetMapping
  ( -- * Creating a Request
    GetMapping (..),
    newGetMapping,

    -- * Request Lenses
    getMapping_location,
    getMapping_sinks,
    getMapping_source,

    -- * Destructuring the Response
    GetMappingResponse (..),
    newGetMappingResponse,

    -- * Response Lenses
    getMappingResponse_httpStatus,
    getMappingResponse_mapping,
  )
where

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

-- | /See:/ 'newGetMapping' smart constructor.
data GetMapping = GetMapping'
  { -- | Parameters for the mapping.
    GetMapping -> Maybe Location
location :: Prelude.Maybe Location,
    -- | A list of target tables.
    GetMapping -> Maybe [CatalogEntry]
sinks :: Prelude.Maybe [CatalogEntry],
    -- | Specifies the source table.
    GetMapping -> CatalogEntry
source :: CatalogEntry
  }
  deriving (GetMapping -> GetMapping -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetMapping -> GetMapping -> Bool
$c/= :: GetMapping -> GetMapping -> Bool
== :: GetMapping -> GetMapping -> Bool
$c== :: GetMapping -> GetMapping -> Bool
Prelude.Eq, ReadPrec [GetMapping]
ReadPrec GetMapping
Int -> ReadS GetMapping
ReadS [GetMapping]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetMapping]
$creadListPrec :: ReadPrec [GetMapping]
readPrec :: ReadPrec GetMapping
$creadPrec :: ReadPrec GetMapping
readList :: ReadS [GetMapping]
$creadList :: ReadS [GetMapping]
readsPrec :: Int -> ReadS GetMapping
$creadsPrec :: Int -> ReadS GetMapping
Prelude.Read, Int -> GetMapping -> ShowS
[GetMapping] -> ShowS
GetMapping -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetMapping] -> ShowS
$cshowList :: [GetMapping] -> ShowS
show :: GetMapping -> String
$cshow :: GetMapping -> String
showsPrec :: Int -> GetMapping -> ShowS
$cshowsPrec :: Int -> GetMapping -> ShowS
Prelude.Show, forall x. Rep GetMapping x -> GetMapping
forall x. GetMapping -> Rep GetMapping x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetMapping x -> GetMapping
$cfrom :: forall x. GetMapping -> Rep GetMapping x
Prelude.Generic)

-- |
-- Create a value of 'GetMapping' 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:
--
-- 'location', 'getMapping_location' - Parameters for the mapping.
--
-- 'sinks', 'getMapping_sinks' - A list of target tables.
--
-- 'source', 'getMapping_source' - Specifies the source table.
newGetMapping ::
  -- | 'source'
  CatalogEntry ->
  GetMapping
newGetMapping :: CatalogEntry -> GetMapping
newGetMapping CatalogEntry
pSource_ =
  GetMapping'
    { $sel:location:GetMapping' :: Maybe Location
location = forall a. Maybe a
Prelude.Nothing,
      $sel:sinks:GetMapping' :: Maybe [CatalogEntry]
sinks = forall a. Maybe a
Prelude.Nothing,
      $sel:source:GetMapping' :: CatalogEntry
source = CatalogEntry
pSource_
    }

-- | Parameters for the mapping.
getMapping_location :: Lens.Lens' GetMapping (Prelude.Maybe Location)
getMapping_location :: Lens' GetMapping (Maybe Location)
getMapping_location = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMapping' {Maybe Location
location :: Maybe Location
$sel:location:GetMapping' :: GetMapping -> Maybe Location
location} -> Maybe Location
location) (\s :: GetMapping
s@GetMapping' {} Maybe Location
a -> GetMapping
s {$sel:location:GetMapping' :: Maybe Location
location = Maybe Location
a} :: GetMapping)

-- | A list of target tables.
getMapping_sinks :: Lens.Lens' GetMapping (Prelude.Maybe [CatalogEntry])
getMapping_sinks :: Lens' GetMapping (Maybe [CatalogEntry])
getMapping_sinks = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMapping' {Maybe [CatalogEntry]
sinks :: Maybe [CatalogEntry]
$sel:sinks:GetMapping' :: GetMapping -> Maybe [CatalogEntry]
sinks} -> Maybe [CatalogEntry]
sinks) (\s :: GetMapping
s@GetMapping' {} Maybe [CatalogEntry]
a -> GetMapping
s {$sel:sinks:GetMapping' :: Maybe [CatalogEntry]
sinks = Maybe [CatalogEntry]
a} :: GetMapping) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | Specifies the source table.
getMapping_source :: Lens.Lens' GetMapping CatalogEntry
getMapping_source :: Lens' GetMapping CatalogEntry
getMapping_source = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMapping' {CatalogEntry
source :: CatalogEntry
$sel:source:GetMapping' :: GetMapping -> CatalogEntry
source} -> CatalogEntry
source) (\s :: GetMapping
s@GetMapping' {} CatalogEntry
a -> GetMapping
s {$sel:source:GetMapping' :: CatalogEntry
source = CatalogEntry
a} :: GetMapping)

instance Core.AWSRequest GetMapping where
  type AWSResponse GetMapping = GetMappingResponse
  request :: (Service -> Service) -> GetMapping -> Request GetMapping
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 GetMapping
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetMapping)))
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 -> [MappingEntry] -> GetMappingResponse
GetMappingResponse'
            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 (Maybe a)
Data..?> Key
"Mapping" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
      )

instance Prelude.Hashable GetMapping where
  hashWithSalt :: Int -> GetMapping -> Int
hashWithSalt Int
_salt GetMapping' {Maybe [CatalogEntry]
Maybe Location
CatalogEntry
source :: CatalogEntry
sinks :: Maybe [CatalogEntry]
location :: Maybe Location
$sel:source:GetMapping' :: GetMapping -> CatalogEntry
$sel:sinks:GetMapping' :: GetMapping -> Maybe [CatalogEntry]
$sel:location:GetMapping' :: GetMapping -> Maybe Location
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Location
location
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [CatalogEntry]
sinks
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` CatalogEntry
source

instance Prelude.NFData GetMapping where
  rnf :: GetMapping -> ()
rnf GetMapping' {Maybe [CatalogEntry]
Maybe Location
CatalogEntry
source :: CatalogEntry
sinks :: Maybe [CatalogEntry]
location :: Maybe Location
$sel:source:GetMapping' :: GetMapping -> CatalogEntry
$sel:sinks:GetMapping' :: GetMapping -> Maybe [CatalogEntry]
$sel:location:GetMapping' :: GetMapping -> Maybe Location
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Location
location
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [CatalogEntry]
sinks
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf CatalogEntry
source

instance Data.ToHeaders GetMapping where
  toHeaders :: GetMapping -> 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
"AWSGlue.GetMapping" :: 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 GetMapping where
  toJSON :: GetMapping -> Value
toJSON GetMapping' {Maybe [CatalogEntry]
Maybe Location
CatalogEntry
source :: CatalogEntry
sinks :: Maybe [CatalogEntry]
location :: Maybe Location
$sel:source:GetMapping' :: GetMapping -> CatalogEntry
$sel:sinks:GetMapping' :: GetMapping -> Maybe [CatalogEntry]
$sel:location:GetMapping' :: GetMapping -> Maybe Location
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Location" 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 Location
location,
            (Key
"Sinks" 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 [CatalogEntry]
sinks,
            forall a. a -> Maybe a
Prelude.Just (Key
"Source" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= CatalogEntry
source)
          ]
      )

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

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

-- | /See:/ 'newGetMappingResponse' smart constructor.
data GetMappingResponse = GetMappingResponse'
  { -- | The response's http status code.
    GetMappingResponse -> Int
httpStatus :: Prelude.Int,
    -- | A list of mappings to the specified targets.
    GetMappingResponse -> [MappingEntry]
mapping :: [MappingEntry]
  }
  deriving (GetMappingResponse -> GetMappingResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetMappingResponse -> GetMappingResponse -> Bool
$c/= :: GetMappingResponse -> GetMappingResponse -> Bool
== :: GetMappingResponse -> GetMappingResponse -> Bool
$c== :: GetMappingResponse -> GetMappingResponse -> Bool
Prelude.Eq, ReadPrec [GetMappingResponse]
ReadPrec GetMappingResponse
Int -> ReadS GetMappingResponse
ReadS [GetMappingResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetMappingResponse]
$creadListPrec :: ReadPrec [GetMappingResponse]
readPrec :: ReadPrec GetMappingResponse
$creadPrec :: ReadPrec GetMappingResponse
readList :: ReadS [GetMappingResponse]
$creadList :: ReadS [GetMappingResponse]
readsPrec :: Int -> ReadS GetMappingResponse
$creadsPrec :: Int -> ReadS GetMappingResponse
Prelude.Read, Int -> GetMappingResponse -> ShowS
[GetMappingResponse] -> ShowS
GetMappingResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetMappingResponse] -> ShowS
$cshowList :: [GetMappingResponse] -> ShowS
show :: GetMappingResponse -> String
$cshow :: GetMappingResponse -> String
showsPrec :: Int -> GetMappingResponse -> ShowS
$cshowsPrec :: Int -> GetMappingResponse -> ShowS
Prelude.Show, forall x. Rep GetMappingResponse x -> GetMappingResponse
forall x. GetMappingResponse -> Rep GetMappingResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetMappingResponse x -> GetMappingResponse
$cfrom :: forall x. GetMappingResponse -> Rep GetMappingResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetMappingResponse' 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', 'getMappingResponse_httpStatus' - The response's http status code.
--
-- 'mapping', 'getMappingResponse_mapping' - A list of mappings to the specified targets.
newGetMappingResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetMappingResponse
newGetMappingResponse :: Int -> GetMappingResponse
newGetMappingResponse Int
pHttpStatus_ =
  GetMappingResponse'
    { $sel:httpStatus:GetMappingResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:mapping:GetMappingResponse' :: [MappingEntry]
mapping = forall a. Monoid a => a
Prelude.mempty
    }

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

-- | A list of mappings to the specified targets.
getMappingResponse_mapping :: Lens.Lens' GetMappingResponse [MappingEntry]
getMappingResponse_mapping :: Lens' GetMappingResponse [MappingEntry]
getMappingResponse_mapping = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMappingResponse' {[MappingEntry]
mapping :: [MappingEntry]
$sel:mapping:GetMappingResponse' :: GetMappingResponse -> [MappingEntry]
mapping} -> [MappingEntry]
mapping) (\s :: GetMappingResponse
s@GetMappingResponse' {} [MappingEntry]
a -> GetMappingResponse
s {$sel:mapping:GetMappingResponse' :: [MappingEntry]
mapping = [MappingEntry]
a} :: GetMappingResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Prelude.NFData GetMappingResponse where
  rnf :: GetMappingResponse -> ()
rnf GetMappingResponse' {Int
[MappingEntry]
mapping :: [MappingEntry]
httpStatus :: Int
$sel:mapping:GetMappingResponse' :: GetMappingResponse -> [MappingEntry]
$sel:httpStatus:GetMappingResponse' :: GetMappingResponse -> 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 [MappingEntry]
mapping