{-# 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.SimSpaceWeaver.StopClock
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Stops the simulation clock.
module Amazonka.SimSpaceWeaver.StopClock
  ( -- * Creating a Request
    StopClock (..),
    newStopClock,

    -- * Request Lenses
    stopClock_simulation,

    -- * Destructuring the Response
    StopClockResponse (..),
    newStopClockResponse,

    -- * Response Lenses
    stopClockResponse_httpStatus,
  )
where

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

-- | /See:/ 'newStopClock' smart constructor.
data StopClock = StopClock'
  { -- | The name of the simulation.
    StopClock -> Text
simulation :: Prelude.Text
  }
  deriving (StopClock -> StopClock -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StopClock -> StopClock -> Bool
$c/= :: StopClock -> StopClock -> Bool
== :: StopClock -> StopClock -> Bool
$c== :: StopClock -> StopClock -> Bool
Prelude.Eq, ReadPrec [StopClock]
ReadPrec StopClock
Int -> ReadS StopClock
ReadS [StopClock]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StopClock]
$creadListPrec :: ReadPrec [StopClock]
readPrec :: ReadPrec StopClock
$creadPrec :: ReadPrec StopClock
readList :: ReadS [StopClock]
$creadList :: ReadS [StopClock]
readsPrec :: Int -> ReadS StopClock
$creadsPrec :: Int -> ReadS StopClock
Prelude.Read, Int -> StopClock -> ShowS
[StopClock] -> ShowS
StopClock -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StopClock] -> ShowS
$cshowList :: [StopClock] -> ShowS
show :: StopClock -> String
$cshow :: StopClock -> String
showsPrec :: Int -> StopClock -> ShowS
$cshowsPrec :: Int -> StopClock -> ShowS
Prelude.Show, forall x. Rep StopClock x -> StopClock
forall x. StopClock -> Rep StopClock x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StopClock x -> StopClock
$cfrom :: forall x. StopClock -> Rep StopClock x
Prelude.Generic)

-- |
-- Create a value of 'StopClock' 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:
--
-- 'simulation', 'stopClock_simulation' - The name of the simulation.
newStopClock ::
  -- | 'simulation'
  Prelude.Text ->
  StopClock
newStopClock :: Text -> StopClock
newStopClock Text
pSimulation_ =
  StopClock' {$sel:simulation:StopClock' :: Text
simulation = Text
pSimulation_}

-- | The name of the simulation.
stopClock_simulation :: Lens.Lens' StopClock Prelude.Text
stopClock_simulation :: Lens' StopClock Text
stopClock_simulation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StopClock' {Text
simulation :: Text
$sel:simulation:StopClock' :: StopClock -> Text
simulation} -> Text
simulation) (\s :: StopClock
s@StopClock' {} Text
a -> StopClock
s {$sel:simulation:StopClock' :: Text
simulation = Text
a} :: StopClock)

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

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

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

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

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

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

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

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

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