{-# 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.StopCrawlerSchedule
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Sets the schedule state of the specified crawler to @NOT_SCHEDULED@, but
-- does not stop the crawler if it is already running.
module Amazonka.Glue.StopCrawlerSchedule
  ( -- * Creating a Request
    StopCrawlerSchedule (..),
    newStopCrawlerSchedule,

    -- * Request Lenses
    stopCrawlerSchedule_crawlerName,

    -- * Destructuring the Response
    StopCrawlerScheduleResponse (..),
    newStopCrawlerScheduleResponse,

    -- * Response Lenses
    stopCrawlerScheduleResponse_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:/ 'newStopCrawlerSchedule' smart constructor.
data StopCrawlerSchedule = StopCrawlerSchedule'
  { -- | Name of the crawler whose schedule state to set.
    StopCrawlerSchedule -> Text
crawlerName :: Prelude.Text
  }
  deriving (StopCrawlerSchedule -> StopCrawlerSchedule -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StopCrawlerSchedule -> StopCrawlerSchedule -> Bool
$c/= :: StopCrawlerSchedule -> StopCrawlerSchedule -> Bool
== :: StopCrawlerSchedule -> StopCrawlerSchedule -> Bool
$c== :: StopCrawlerSchedule -> StopCrawlerSchedule -> Bool
Prelude.Eq, ReadPrec [StopCrawlerSchedule]
ReadPrec StopCrawlerSchedule
Int -> ReadS StopCrawlerSchedule
ReadS [StopCrawlerSchedule]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StopCrawlerSchedule]
$creadListPrec :: ReadPrec [StopCrawlerSchedule]
readPrec :: ReadPrec StopCrawlerSchedule
$creadPrec :: ReadPrec StopCrawlerSchedule
readList :: ReadS [StopCrawlerSchedule]
$creadList :: ReadS [StopCrawlerSchedule]
readsPrec :: Int -> ReadS StopCrawlerSchedule
$creadsPrec :: Int -> ReadS StopCrawlerSchedule
Prelude.Read, Int -> StopCrawlerSchedule -> ShowS
[StopCrawlerSchedule] -> ShowS
StopCrawlerSchedule -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StopCrawlerSchedule] -> ShowS
$cshowList :: [StopCrawlerSchedule] -> ShowS
show :: StopCrawlerSchedule -> String
$cshow :: StopCrawlerSchedule -> String
showsPrec :: Int -> StopCrawlerSchedule -> ShowS
$cshowsPrec :: Int -> StopCrawlerSchedule -> ShowS
Prelude.Show, forall x. Rep StopCrawlerSchedule x -> StopCrawlerSchedule
forall x. StopCrawlerSchedule -> Rep StopCrawlerSchedule x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StopCrawlerSchedule x -> StopCrawlerSchedule
$cfrom :: forall x. StopCrawlerSchedule -> Rep StopCrawlerSchedule x
Prelude.Generic)

-- |
-- Create a value of 'StopCrawlerSchedule' 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:
--
-- 'crawlerName', 'stopCrawlerSchedule_crawlerName' - Name of the crawler whose schedule state to set.
newStopCrawlerSchedule ::
  -- | 'crawlerName'
  Prelude.Text ->
  StopCrawlerSchedule
newStopCrawlerSchedule :: Text -> StopCrawlerSchedule
newStopCrawlerSchedule Text
pCrawlerName_ =
  StopCrawlerSchedule' {$sel:crawlerName:StopCrawlerSchedule' :: Text
crawlerName = Text
pCrawlerName_}

-- | Name of the crawler whose schedule state to set.
stopCrawlerSchedule_crawlerName :: Lens.Lens' StopCrawlerSchedule Prelude.Text
stopCrawlerSchedule_crawlerName :: Lens' StopCrawlerSchedule Text
stopCrawlerSchedule_crawlerName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StopCrawlerSchedule' {Text
crawlerName :: Text
$sel:crawlerName:StopCrawlerSchedule' :: StopCrawlerSchedule -> Text
crawlerName} -> Text
crawlerName) (\s :: StopCrawlerSchedule
s@StopCrawlerSchedule' {} Text
a -> StopCrawlerSchedule
s {$sel:crawlerName:StopCrawlerSchedule' :: Text
crawlerName = Text
a} :: StopCrawlerSchedule)

instance Core.AWSRequest StopCrawlerSchedule where
  type
    AWSResponse StopCrawlerSchedule =
      StopCrawlerScheduleResponse
  request :: (Service -> Service)
-> StopCrawlerSchedule -> Request StopCrawlerSchedule
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 StopCrawlerSchedule
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse StopCrawlerSchedule)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> StopCrawlerScheduleResponse
StopCrawlerScheduleResponse'
            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))
      )

instance Prelude.Hashable StopCrawlerSchedule where
  hashWithSalt :: Int -> StopCrawlerSchedule -> Int
hashWithSalt Int
_salt StopCrawlerSchedule' {Text
crawlerName :: Text
$sel:crawlerName:StopCrawlerSchedule' :: StopCrawlerSchedule -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
crawlerName

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

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

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

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

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

-- |
-- Create a value of 'StopCrawlerScheduleResponse' 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', 'stopCrawlerScheduleResponse_httpStatus' - The response's http status code.
newStopCrawlerScheduleResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  StopCrawlerScheduleResponse
newStopCrawlerScheduleResponse :: Int -> StopCrawlerScheduleResponse
newStopCrawlerScheduleResponse Int
pHttpStatus_ =
  StopCrawlerScheduleResponse'
    { $sel:httpStatus:StopCrawlerScheduleResponse' :: Int
httpStatus =
        Int
pHttpStatus_
    }

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

instance Prelude.NFData StopCrawlerScheduleResponse where
  rnf :: StopCrawlerScheduleResponse -> ()
rnf StopCrawlerScheduleResponse' {Int
httpStatus :: Int
$sel:httpStatus:StopCrawlerScheduleResponse' :: StopCrawlerScheduleResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus