{-# 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.GetCrawler
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves metadata for a specified crawler.
module Amazonka.Glue.GetCrawler
  ( -- * Creating a Request
    GetCrawler (..),
    newGetCrawler,

    -- * Request Lenses
    getCrawler_name,

    -- * Destructuring the Response
    GetCrawlerResponse (..),
    newGetCrawlerResponse,

    -- * Response Lenses
    getCrawlerResponse_crawler,
    getCrawlerResponse_httpStatus,
  )
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:/ 'newGetCrawler' smart constructor.
data GetCrawler = GetCrawler'
  { -- | The name of the crawler to retrieve metadata for.
    GetCrawler -> Text
name :: Prelude.Text
  }
  deriving (GetCrawler -> GetCrawler -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetCrawler -> GetCrawler -> Bool
$c/= :: GetCrawler -> GetCrawler -> Bool
== :: GetCrawler -> GetCrawler -> Bool
$c== :: GetCrawler -> GetCrawler -> Bool
Prelude.Eq, ReadPrec [GetCrawler]
ReadPrec GetCrawler
Int -> ReadS GetCrawler
ReadS [GetCrawler]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetCrawler]
$creadListPrec :: ReadPrec [GetCrawler]
readPrec :: ReadPrec GetCrawler
$creadPrec :: ReadPrec GetCrawler
readList :: ReadS [GetCrawler]
$creadList :: ReadS [GetCrawler]
readsPrec :: Int -> ReadS GetCrawler
$creadsPrec :: Int -> ReadS GetCrawler
Prelude.Read, Int -> GetCrawler -> ShowS
[GetCrawler] -> ShowS
GetCrawler -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetCrawler] -> ShowS
$cshowList :: [GetCrawler] -> ShowS
show :: GetCrawler -> String
$cshow :: GetCrawler -> String
showsPrec :: Int -> GetCrawler -> ShowS
$cshowsPrec :: Int -> GetCrawler -> ShowS
Prelude.Show, forall x. Rep GetCrawler x -> GetCrawler
forall x. GetCrawler -> Rep GetCrawler x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetCrawler x -> GetCrawler
$cfrom :: forall x. GetCrawler -> Rep GetCrawler x
Prelude.Generic)

-- |
-- Create a value of 'GetCrawler' 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:
--
-- 'name', 'getCrawler_name' - The name of the crawler to retrieve metadata for.
newGetCrawler ::
  -- | 'name'
  Prelude.Text ->
  GetCrawler
newGetCrawler :: Text -> GetCrawler
newGetCrawler Text
pName_ = GetCrawler' {$sel:name:GetCrawler' :: Text
name = Text
pName_}

-- | The name of the crawler to retrieve metadata for.
getCrawler_name :: Lens.Lens' GetCrawler Prelude.Text
getCrawler_name :: Lens' GetCrawler Text
getCrawler_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCrawler' {Text
name :: Text
$sel:name:GetCrawler' :: GetCrawler -> Text
name} -> Text
name) (\s :: GetCrawler
s@GetCrawler' {} Text
a -> GetCrawler
s {$sel:name:GetCrawler' :: Text
name = Text
a} :: GetCrawler)

instance Core.AWSRequest GetCrawler where
  type AWSResponse GetCrawler = GetCrawlerResponse
  request :: (Service -> Service) -> GetCrawler -> Request GetCrawler
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 GetCrawler
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetCrawler)))
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 Crawler -> Int -> GetCrawlerResponse
GetCrawlerResponse'
            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
"Crawler")
            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 GetCrawler where
  hashWithSalt :: Int -> GetCrawler -> Int
hashWithSalt Int
_salt GetCrawler' {Text
name :: Text
$sel:name:GetCrawler' :: GetCrawler -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

instance Prelude.NFData GetCrawler where
  rnf :: GetCrawler -> ()
rnf GetCrawler' {Text
name :: Text
$sel:name:GetCrawler' :: GetCrawler -> Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Text
name

instance Data.ToHeaders GetCrawler where
  toHeaders :: GetCrawler -> 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.GetCrawler" :: 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 GetCrawler where
  toJSON :: GetCrawler -> Value
toJSON GetCrawler' {Text
name :: Text
$sel:name:GetCrawler' :: GetCrawler -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [forall a. a -> Maybe a
Prelude.Just (Key
"Name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name)]
      )

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

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

-- | /See:/ 'newGetCrawlerResponse' smart constructor.
data GetCrawlerResponse = GetCrawlerResponse'
  { -- | The metadata for the specified crawler.
    GetCrawlerResponse -> Maybe Crawler
crawler :: Prelude.Maybe Crawler,
    -- | The response's http status code.
    GetCrawlerResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetCrawlerResponse -> GetCrawlerResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetCrawlerResponse -> GetCrawlerResponse -> Bool
$c/= :: GetCrawlerResponse -> GetCrawlerResponse -> Bool
== :: GetCrawlerResponse -> GetCrawlerResponse -> Bool
$c== :: GetCrawlerResponse -> GetCrawlerResponse -> Bool
Prelude.Eq, ReadPrec [GetCrawlerResponse]
ReadPrec GetCrawlerResponse
Int -> ReadS GetCrawlerResponse
ReadS [GetCrawlerResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetCrawlerResponse]
$creadListPrec :: ReadPrec [GetCrawlerResponse]
readPrec :: ReadPrec GetCrawlerResponse
$creadPrec :: ReadPrec GetCrawlerResponse
readList :: ReadS [GetCrawlerResponse]
$creadList :: ReadS [GetCrawlerResponse]
readsPrec :: Int -> ReadS GetCrawlerResponse
$creadsPrec :: Int -> ReadS GetCrawlerResponse
Prelude.Read, Int -> GetCrawlerResponse -> ShowS
[GetCrawlerResponse] -> ShowS
GetCrawlerResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetCrawlerResponse] -> ShowS
$cshowList :: [GetCrawlerResponse] -> ShowS
show :: GetCrawlerResponse -> String
$cshow :: GetCrawlerResponse -> String
showsPrec :: Int -> GetCrawlerResponse -> ShowS
$cshowsPrec :: Int -> GetCrawlerResponse -> ShowS
Prelude.Show, forall x. Rep GetCrawlerResponse x -> GetCrawlerResponse
forall x. GetCrawlerResponse -> Rep GetCrawlerResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetCrawlerResponse x -> GetCrawlerResponse
$cfrom :: forall x. GetCrawlerResponse -> Rep GetCrawlerResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetCrawlerResponse' 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:
--
-- 'crawler', 'getCrawlerResponse_crawler' - The metadata for the specified crawler.
--
-- 'httpStatus', 'getCrawlerResponse_httpStatus' - The response's http status code.
newGetCrawlerResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetCrawlerResponse
newGetCrawlerResponse :: Int -> GetCrawlerResponse
newGetCrawlerResponse Int
pHttpStatus_ =
  GetCrawlerResponse'
    { $sel:crawler:GetCrawlerResponse' :: Maybe Crawler
crawler = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetCrawlerResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The metadata for the specified crawler.
getCrawlerResponse_crawler :: Lens.Lens' GetCrawlerResponse (Prelude.Maybe Crawler)
getCrawlerResponse_crawler :: Lens' GetCrawlerResponse (Maybe Crawler)
getCrawlerResponse_crawler = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCrawlerResponse' {Maybe Crawler
crawler :: Maybe Crawler
$sel:crawler:GetCrawlerResponse' :: GetCrawlerResponse -> Maybe Crawler
crawler} -> Maybe Crawler
crawler) (\s :: GetCrawlerResponse
s@GetCrawlerResponse' {} Maybe Crawler
a -> GetCrawlerResponse
s {$sel:crawler:GetCrawlerResponse' :: Maybe Crawler
crawler = Maybe Crawler
a} :: GetCrawlerResponse)

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

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