{-# 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.GetLaunch
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns the details about one launch. You must already know the launch
-- name. To retrieve a list of launches in your account, use
-- <https://docs.aws.amazon.com/cloudwatchevidently/latest/APIReference/API_ListLaunches.html ListLaunches>.
module Amazonka.Evidently.GetLaunch
  ( -- * Creating a Request
    GetLaunch (..),
    newGetLaunch,

    -- * Request Lenses
    getLaunch_launch,
    getLaunch_project,

    -- * Destructuring the Response
    GetLaunchResponse (..),
    newGetLaunchResponse,

    -- * Response Lenses
    getLaunchResponse_launch,
    getLaunchResponse_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:/ 'newGetLaunch' smart constructor.
data GetLaunch = GetLaunch'
  { -- | The name of the launch that you want to see the details of.
    GetLaunch -> Text
launch :: Prelude.Text,
    -- | The name or ARN of the project that contains the launch.
    GetLaunch -> Text
project :: Prelude.Text
  }
  deriving (GetLaunch -> GetLaunch -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetLaunch -> GetLaunch -> Bool
$c/= :: GetLaunch -> GetLaunch -> Bool
== :: GetLaunch -> GetLaunch -> Bool
$c== :: GetLaunch -> GetLaunch -> Bool
Prelude.Eq, ReadPrec [GetLaunch]
ReadPrec GetLaunch
Int -> ReadS GetLaunch
ReadS [GetLaunch]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetLaunch]
$creadListPrec :: ReadPrec [GetLaunch]
readPrec :: ReadPrec GetLaunch
$creadPrec :: ReadPrec GetLaunch
readList :: ReadS [GetLaunch]
$creadList :: ReadS [GetLaunch]
readsPrec :: Int -> ReadS GetLaunch
$creadsPrec :: Int -> ReadS GetLaunch
Prelude.Read, Int -> GetLaunch -> ShowS
[GetLaunch] -> ShowS
GetLaunch -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetLaunch] -> ShowS
$cshowList :: [GetLaunch] -> ShowS
show :: GetLaunch -> String
$cshow :: GetLaunch -> String
showsPrec :: Int -> GetLaunch -> ShowS
$cshowsPrec :: Int -> GetLaunch -> ShowS
Prelude.Show, forall x. Rep GetLaunch x -> GetLaunch
forall x. GetLaunch -> Rep GetLaunch x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetLaunch x -> GetLaunch
$cfrom :: forall x. GetLaunch -> Rep GetLaunch x
Prelude.Generic)

-- |
-- Create a value of 'GetLaunch' 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:
--
-- 'launch', 'getLaunch_launch' - The name of the launch that you want to see the details of.
--
-- 'project', 'getLaunch_project' - The name or ARN of the project that contains the launch.
newGetLaunch ::
  -- | 'launch'
  Prelude.Text ->
  -- | 'project'
  Prelude.Text ->
  GetLaunch
newGetLaunch :: Text -> Text -> GetLaunch
newGetLaunch Text
pLaunch_ Text
pProject_ =
  GetLaunch' {$sel:launch:GetLaunch' :: Text
launch = Text
pLaunch_, $sel:project:GetLaunch' :: Text
project = Text
pProject_}

-- | The name of the launch that you want to see the details of.
getLaunch_launch :: Lens.Lens' GetLaunch Prelude.Text
getLaunch_launch :: Lens' GetLaunch Text
getLaunch_launch = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetLaunch' {Text
launch :: Text
$sel:launch:GetLaunch' :: GetLaunch -> Text
launch} -> Text
launch) (\s :: GetLaunch
s@GetLaunch' {} Text
a -> GetLaunch
s {$sel:launch:GetLaunch' :: Text
launch = Text
a} :: GetLaunch)

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

instance Core.AWSRequest GetLaunch where
  type AWSResponse GetLaunch = GetLaunchResponse
  request :: (Service -> Service) -> GetLaunch -> Request GetLaunch
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetLaunch
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetLaunch)))
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 Launch -> Int -> GetLaunchResponse
GetLaunchResponse'
            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
"launch")
            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 GetLaunch where
  hashWithSalt :: Int -> GetLaunch -> Int
hashWithSalt Int
_salt GetLaunch' {Text
project :: Text
launch :: Text
$sel:project:GetLaunch' :: GetLaunch -> Text
$sel:launch:GetLaunch' :: GetLaunch -> Text
..} =
    Int
_salt
      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 GetLaunch where
  rnf :: GetLaunch -> ()
rnf GetLaunch' {Text
project :: Text
launch :: Text
$sel:project:GetLaunch' :: GetLaunch -> Text
$sel:launch:GetLaunch' :: GetLaunch -> Text
..} =
    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 GetLaunch where
  toHeaders :: GetLaunch -> 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.ToPath GetLaunch where
  toPath :: GetLaunch -> ByteString
toPath GetLaunch' {Text
project :: Text
launch :: Text
$sel:project:GetLaunch' :: GetLaunch -> Text
$sel:launch:GetLaunch' :: GetLaunch -> Text
..} =
    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
      ]

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

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

-- |
-- Create a value of 'GetLaunchResponse' 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:
--
-- 'launch', 'getLaunchResponse_launch' - A structure containing the configuration details of the launch.
--
-- 'httpStatus', 'getLaunchResponse_httpStatus' - The response's http status code.
newGetLaunchResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetLaunchResponse
newGetLaunchResponse :: Int -> GetLaunchResponse
newGetLaunchResponse Int
pHttpStatus_ =
  GetLaunchResponse'
    { $sel:launch:GetLaunchResponse' :: Maybe Launch
launch = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetLaunchResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A structure containing the configuration details of the launch.
getLaunchResponse_launch :: Lens.Lens' GetLaunchResponse (Prelude.Maybe Launch)
getLaunchResponse_launch :: Lens' GetLaunchResponse (Maybe Launch)
getLaunchResponse_launch = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetLaunchResponse' {Maybe Launch
launch :: Maybe Launch
$sel:launch:GetLaunchResponse' :: GetLaunchResponse -> Maybe Launch
launch} -> Maybe Launch
launch) (\s :: GetLaunchResponse
s@GetLaunchResponse' {} Maybe Launch
a -> GetLaunchResponse
s {$sel:launch:GetLaunchResponse' :: Maybe Launch
launch = Maybe Launch
a} :: GetLaunchResponse)

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

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