{-# 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.Evidently.StopLaunch
-- 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 a launch that is currently running. After you stop a launch, you
-- will not be able to resume it or restart it. Also, it will not be
-- evaluated as a rule for traffic allocation, and the traffic that was
-- allocated to the launch will instead be available to the feature\'s
-- experiment, if there is one. Otherwise, all traffic will be served the
-- default variation after the launch is stopped.
module Amazonka.Evidently.StopLaunch
  ( -- * Creating a Request
    StopLaunch (..),
    newStopLaunch,

    -- * Request Lenses
    stopLaunch_desiredState,
    stopLaunch_reason,
    stopLaunch_launch,
    stopLaunch_project,

    -- * Destructuring the Response
    StopLaunchResponse (..),
    newStopLaunchResponse,

    -- * Response Lenses
    stopLaunchResponse_endedTime,
    stopLaunchResponse_httpStatus,
  )
where

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

-- | /See:/ 'newStopLaunch' smart constructor.
data StopLaunch = StopLaunch'
  { -- | Specify whether to consider the launch as @COMPLETED@ or @CANCELLED@
    -- after it stops.
    StopLaunch -> Maybe LaunchStopDesiredState
desiredState :: Prelude.Maybe LaunchStopDesiredState,
    -- | A string that describes why you are stopping the launch.
    StopLaunch -> Maybe Text
reason :: Prelude.Maybe Prelude.Text,
    -- | The name of the launch to stop.
    StopLaunch -> Text
launch :: Prelude.Text,
    -- | The name or ARN of the project that contains the launch that you want to
    -- stop.
    StopLaunch -> Text
project :: Prelude.Text
  }
  deriving (StopLaunch -> StopLaunch -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StopLaunch -> StopLaunch -> Bool
$c/= :: StopLaunch -> StopLaunch -> Bool
== :: StopLaunch -> StopLaunch -> Bool
$c== :: StopLaunch -> StopLaunch -> Bool
Prelude.Eq, ReadPrec [StopLaunch]
ReadPrec StopLaunch
Int -> ReadS StopLaunch
ReadS [StopLaunch]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StopLaunch]
$creadListPrec :: ReadPrec [StopLaunch]
readPrec :: ReadPrec StopLaunch
$creadPrec :: ReadPrec StopLaunch
readList :: ReadS [StopLaunch]
$creadList :: ReadS [StopLaunch]
readsPrec :: Int -> ReadS StopLaunch
$creadsPrec :: Int -> ReadS StopLaunch
Prelude.Read, Int -> StopLaunch -> ShowS
[StopLaunch] -> ShowS
StopLaunch -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StopLaunch] -> ShowS
$cshowList :: [StopLaunch] -> ShowS
show :: StopLaunch -> String
$cshow :: StopLaunch -> String
showsPrec :: Int -> StopLaunch -> ShowS
$cshowsPrec :: Int -> StopLaunch -> ShowS
Prelude.Show, forall x. Rep StopLaunch x -> StopLaunch
forall x. StopLaunch -> Rep StopLaunch x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StopLaunch x -> StopLaunch
$cfrom :: forall x. StopLaunch -> Rep StopLaunch x
Prelude.Generic)

-- |
-- Create a value of 'StopLaunch' 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:
--
-- 'desiredState', 'stopLaunch_desiredState' - Specify whether to consider the launch as @COMPLETED@ or @CANCELLED@
-- after it stops.
--
-- 'reason', 'stopLaunch_reason' - A string that describes why you are stopping the launch.
--
-- 'launch', 'stopLaunch_launch' - The name of the launch to stop.
--
-- 'project', 'stopLaunch_project' - The name or ARN of the project that contains the launch that you want to
-- stop.
newStopLaunch ::
  -- | 'launch'
  Prelude.Text ->
  -- | 'project'
  Prelude.Text ->
  StopLaunch
newStopLaunch :: Text -> Text -> StopLaunch
newStopLaunch Text
pLaunch_ Text
pProject_ =
  StopLaunch'
    { $sel:desiredState:StopLaunch' :: Maybe LaunchStopDesiredState
desiredState = forall a. Maybe a
Prelude.Nothing,
      $sel:reason:StopLaunch' :: Maybe Text
reason = forall a. Maybe a
Prelude.Nothing,
      $sel:launch:StopLaunch' :: Text
launch = Text
pLaunch_,
      $sel:project:StopLaunch' :: Text
project = Text
pProject_
    }

-- | Specify whether to consider the launch as @COMPLETED@ or @CANCELLED@
-- after it stops.
stopLaunch_desiredState :: Lens.Lens' StopLaunch (Prelude.Maybe LaunchStopDesiredState)
stopLaunch_desiredState :: Lens' StopLaunch (Maybe LaunchStopDesiredState)
stopLaunch_desiredState = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StopLaunch' {Maybe LaunchStopDesiredState
desiredState :: Maybe LaunchStopDesiredState
$sel:desiredState:StopLaunch' :: StopLaunch -> Maybe LaunchStopDesiredState
desiredState} -> Maybe LaunchStopDesiredState
desiredState) (\s :: StopLaunch
s@StopLaunch' {} Maybe LaunchStopDesiredState
a -> StopLaunch
s {$sel:desiredState:StopLaunch' :: Maybe LaunchStopDesiredState
desiredState = Maybe LaunchStopDesiredState
a} :: StopLaunch)

-- | A string that describes why you are stopping the launch.
stopLaunch_reason :: Lens.Lens' StopLaunch (Prelude.Maybe Prelude.Text)
stopLaunch_reason :: Lens' StopLaunch (Maybe Text)
stopLaunch_reason = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StopLaunch' {Maybe Text
reason :: Maybe Text
$sel:reason:StopLaunch' :: StopLaunch -> Maybe Text
reason} -> Maybe Text
reason) (\s :: StopLaunch
s@StopLaunch' {} Maybe Text
a -> StopLaunch
s {$sel:reason:StopLaunch' :: Maybe Text
reason = Maybe Text
a} :: StopLaunch)

-- | The name of the launch to stop.
stopLaunch_launch :: Lens.Lens' StopLaunch Prelude.Text
stopLaunch_launch :: Lens' StopLaunch Text
stopLaunch_launch = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StopLaunch' {Text
launch :: Text
$sel:launch:StopLaunch' :: StopLaunch -> Text
launch} -> Text
launch) (\s :: StopLaunch
s@StopLaunch' {} Text
a -> StopLaunch
s {$sel:launch:StopLaunch' :: Text
launch = Text
a} :: StopLaunch)

-- | The name or ARN of the project that contains the launch that you want to
-- stop.
stopLaunch_project :: Lens.Lens' StopLaunch Prelude.Text
stopLaunch_project :: Lens' StopLaunch Text
stopLaunch_project = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StopLaunch' {Text
project :: Text
$sel:project:StopLaunch' :: StopLaunch -> Text
project} -> Text
project) (\s :: StopLaunch
s@StopLaunch' {} Text
a -> StopLaunch
s {$sel:project:StopLaunch' :: Text
project = Text
a} :: StopLaunch)

instance Core.AWSRequest StopLaunch where
  type AWSResponse StopLaunch = StopLaunchResponse
  request :: (Service -> Service) -> StopLaunch -> Request StopLaunch
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 StopLaunch
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse StopLaunch)))
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 POSIX -> Int -> StopLaunchResponse
StopLaunchResponse'
            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
"endedTime")
            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 StopLaunch where
  hashWithSalt :: Int -> StopLaunch -> Int
hashWithSalt Int
_salt StopLaunch' {Maybe Text
Maybe LaunchStopDesiredState
Text
project :: Text
launch :: Text
reason :: Maybe Text
desiredState :: Maybe LaunchStopDesiredState
$sel:project:StopLaunch' :: StopLaunch -> Text
$sel:launch:StopLaunch' :: StopLaunch -> Text
$sel:reason:StopLaunch' :: StopLaunch -> Maybe Text
$sel:desiredState:StopLaunch' :: StopLaunch -> Maybe LaunchStopDesiredState
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe LaunchStopDesiredState
desiredState
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
reason
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
launch
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
project

instance Prelude.NFData StopLaunch where
  rnf :: StopLaunch -> ()
rnf StopLaunch' {Maybe Text
Maybe LaunchStopDesiredState
Text
project :: Text
launch :: Text
reason :: Maybe Text
desiredState :: Maybe LaunchStopDesiredState
$sel:project:StopLaunch' :: StopLaunch -> Text
$sel:launch:StopLaunch' :: StopLaunch -> Text
$sel:reason:StopLaunch' :: StopLaunch -> Maybe Text
$sel:desiredState:StopLaunch' :: StopLaunch -> Maybe LaunchStopDesiredState
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe LaunchStopDesiredState
desiredState
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
reason
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
launch
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
project

instance Data.ToHeaders StopLaunch where
  toHeaders :: StopLaunch -> 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 StopLaunch where
  toJSON :: StopLaunch -> Value
toJSON StopLaunch' {Maybe Text
Maybe LaunchStopDesiredState
Text
project :: Text
launch :: Text
reason :: Maybe Text
desiredState :: Maybe LaunchStopDesiredState
$sel:project:StopLaunch' :: StopLaunch -> Text
$sel:launch:StopLaunch' :: StopLaunch -> Text
$sel:reason:StopLaunch' :: StopLaunch -> Maybe Text
$sel:desiredState:StopLaunch' :: StopLaunch -> Maybe LaunchStopDesiredState
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"desiredState" 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 LaunchStopDesiredState
desiredState,
            (Key
"reason" 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 Text
reason
          ]
      )

instance Data.ToPath StopLaunch where
  toPath :: StopLaunch -> ByteString
toPath StopLaunch' {Maybe Text
Maybe LaunchStopDesiredState
Text
project :: Text
launch :: Text
reason :: Maybe Text
desiredState :: Maybe LaunchStopDesiredState
$sel:project:StopLaunch' :: StopLaunch -> Text
$sel:launch:StopLaunch' :: StopLaunch -> Text
$sel:reason:StopLaunch' :: StopLaunch -> Maybe Text
$sel:desiredState:StopLaunch' :: StopLaunch -> Maybe LaunchStopDesiredState
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/projects/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
project,
        ByteString
"/launches/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
launch,
        ByteString
"/cancel"
      ]

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

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

-- |
-- Create a value of 'StopLaunchResponse' 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:
--
-- 'endedTime', 'stopLaunchResponse_endedTime' - The date and time that the launch stopped.
--
-- 'httpStatus', 'stopLaunchResponse_httpStatus' - The response's http status code.
newStopLaunchResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  StopLaunchResponse
newStopLaunchResponse :: Int -> StopLaunchResponse
newStopLaunchResponse Int
pHttpStatus_ =
  StopLaunchResponse'
    { $sel:endedTime:StopLaunchResponse' :: Maybe POSIX
endedTime = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:StopLaunchResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The date and time that the launch stopped.
stopLaunchResponse_endedTime :: Lens.Lens' StopLaunchResponse (Prelude.Maybe Prelude.UTCTime)
stopLaunchResponse_endedTime :: Lens' StopLaunchResponse (Maybe UTCTime)
stopLaunchResponse_endedTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StopLaunchResponse' {Maybe POSIX
endedTime :: Maybe POSIX
$sel:endedTime:StopLaunchResponse' :: StopLaunchResponse -> Maybe POSIX
endedTime} -> Maybe POSIX
endedTime) (\s :: StopLaunchResponse
s@StopLaunchResponse' {} Maybe POSIX
a -> StopLaunchResponse
s {$sel:endedTime:StopLaunchResponse' :: Maybe POSIX
endedTime = Maybe POSIX
a} :: StopLaunchResponse) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

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

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