{-# 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.MGN.StartTest
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Launches a Test Instance for specific Source Servers. This command
-- starts a LAUNCH job whose initiatedBy property is StartTest and changes
-- the SourceServer.lifeCycle.state property to TESTING.
module Amazonka.MGN.StartTest
  ( -- * Creating a Request
    StartTest (..),
    newStartTest,

    -- * Request Lenses
    startTest_tags,
    startTest_sourceServerIDs,

    -- * Destructuring the Response
    StartTestResponse (..),
    newStartTestResponse,

    -- * Response Lenses
    startTestResponse_job,
    startTestResponse_httpStatus,
  )
where

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

-- | /See:/ 'newStartTest' smart constructor.
data StartTest = StartTest'
  { -- | Start Test by Tags.
    StartTest -> Maybe (Sensitive (HashMap Text Text))
tags :: Prelude.Maybe (Data.Sensitive (Prelude.HashMap Prelude.Text Prelude.Text)),
    -- | Start Test for Source Server IDs.
    StartTest -> NonEmpty Text
sourceServerIDs :: Prelude.NonEmpty Prelude.Text
  }
  deriving (StartTest -> StartTest -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartTest -> StartTest -> Bool
$c/= :: StartTest -> StartTest -> Bool
== :: StartTest -> StartTest -> Bool
$c== :: StartTest -> StartTest -> Bool
Prelude.Eq, Int -> StartTest -> ShowS
[StartTest] -> ShowS
StartTest -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartTest] -> ShowS
$cshowList :: [StartTest] -> ShowS
show :: StartTest -> String
$cshow :: StartTest -> String
showsPrec :: Int -> StartTest -> ShowS
$cshowsPrec :: Int -> StartTest -> ShowS
Prelude.Show, forall x. Rep StartTest x -> StartTest
forall x. StartTest -> Rep StartTest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartTest x -> StartTest
$cfrom :: forall x. StartTest -> Rep StartTest x
Prelude.Generic)

-- |
-- Create a value of 'StartTest' 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:
--
-- 'tags', 'startTest_tags' - Start Test by Tags.
--
-- 'sourceServerIDs', 'startTest_sourceServerIDs' - Start Test for Source Server IDs.
newStartTest ::
  -- | 'sourceServerIDs'
  Prelude.NonEmpty Prelude.Text ->
  StartTest
newStartTest :: NonEmpty Text -> StartTest
newStartTest NonEmpty Text
pSourceServerIDs_ =
  StartTest'
    { $sel:tags:StartTest' :: Maybe (Sensitive (HashMap Text Text))
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:sourceServerIDs:StartTest' :: NonEmpty Text
sourceServerIDs =
        forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty Text
pSourceServerIDs_
    }

-- | Start Test by Tags.
startTest_tags :: Lens.Lens' StartTest (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
startTest_tags :: Lens' StartTest (Maybe (HashMap Text Text))
startTest_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartTest' {Maybe (Sensitive (HashMap Text Text))
tags :: Maybe (Sensitive (HashMap Text Text))
$sel:tags:StartTest' :: StartTest -> Maybe (Sensitive (HashMap Text Text))
tags} -> Maybe (Sensitive (HashMap Text Text))
tags) (\s :: StartTest
s@StartTest' {} Maybe (Sensitive (HashMap Text Text))
a -> StartTest
s {$sel:tags:StartTest' :: Maybe (Sensitive (HashMap Text Text))
tags = Maybe (Sensitive (HashMap Text Text))
a} :: StartTest) 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. Iso' (Sensitive a) a
Data._Sensitive forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced)

-- | Start Test for Source Server IDs.
startTest_sourceServerIDs :: Lens.Lens' StartTest (Prelude.NonEmpty Prelude.Text)
startTest_sourceServerIDs :: Lens' StartTest (NonEmpty Text)
startTest_sourceServerIDs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartTest' {NonEmpty Text
sourceServerIDs :: NonEmpty Text
$sel:sourceServerIDs:StartTest' :: StartTest -> NonEmpty Text
sourceServerIDs} -> NonEmpty Text
sourceServerIDs) (\s :: StartTest
s@StartTest' {} NonEmpty Text
a -> StartTest
s {$sel:sourceServerIDs:StartTest' :: NonEmpty Text
sourceServerIDs = NonEmpty Text
a} :: StartTest) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest StartTest where
  type AWSResponse StartTest = StartTestResponse
  request :: (Service -> Service) -> StartTest -> Request StartTest
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 StartTest
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse StartTest)))
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 Job -> Int -> StartTestResponse
StartTestResponse'
            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
"job")
            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 StartTest where
  hashWithSalt :: Int -> StartTest -> Int
hashWithSalt Int
_salt StartTest' {Maybe (Sensitive (HashMap Text Text))
NonEmpty Text
sourceServerIDs :: NonEmpty Text
tags :: Maybe (Sensitive (HashMap Text Text))
$sel:sourceServerIDs:StartTest' :: StartTest -> NonEmpty Text
$sel:tags:StartTest' :: StartTest -> Maybe (Sensitive (HashMap Text Text))
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive (HashMap Text Text))
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty Text
sourceServerIDs

instance Prelude.NFData StartTest where
  rnf :: StartTest -> ()
rnf StartTest' {Maybe (Sensitive (HashMap Text Text))
NonEmpty Text
sourceServerIDs :: NonEmpty Text
tags :: Maybe (Sensitive (HashMap Text Text))
$sel:sourceServerIDs:StartTest' :: StartTest -> NonEmpty Text
$sel:tags:StartTest' :: StartTest -> Maybe (Sensitive (HashMap Text Text))
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive (HashMap Text Text))
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty Text
sourceServerIDs

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

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

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

-- | /See:/ 'newStartTestResponse' smart constructor.
data StartTestResponse = StartTestResponse'
  { -- | Start Test Job response.
    StartTestResponse -> Maybe Job
job :: Prelude.Maybe Job,
    -- | The response's http status code.
    StartTestResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (StartTestResponse -> StartTestResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartTestResponse -> StartTestResponse -> Bool
$c/= :: StartTestResponse -> StartTestResponse -> Bool
== :: StartTestResponse -> StartTestResponse -> Bool
$c== :: StartTestResponse -> StartTestResponse -> Bool
Prelude.Eq, Int -> StartTestResponse -> ShowS
[StartTestResponse] -> ShowS
StartTestResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartTestResponse] -> ShowS
$cshowList :: [StartTestResponse] -> ShowS
show :: StartTestResponse -> String
$cshow :: StartTestResponse -> String
showsPrec :: Int -> StartTestResponse -> ShowS
$cshowsPrec :: Int -> StartTestResponse -> ShowS
Prelude.Show, forall x. Rep StartTestResponse x -> StartTestResponse
forall x. StartTestResponse -> Rep StartTestResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartTestResponse x -> StartTestResponse
$cfrom :: forall x. StartTestResponse -> Rep StartTestResponse x
Prelude.Generic)

-- |
-- Create a value of 'StartTestResponse' 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:
--
-- 'job', 'startTestResponse_job' - Start Test Job response.
--
-- 'httpStatus', 'startTestResponse_httpStatus' - The response's http status code.
newStartTestResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  StartTestResponse
newStartTestResponse :: Int -> StartTestResponse
newStartTestResponse Int
pHttpStatus_ =
  StartTestResponse'
    { $sel:job:StartTestResponse' :: Maybe Job
job = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:StartTestResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Start Test Job response.
startTestResponse_job :: Lens.Lens' StartTestResponse (Prelude.Maybe Job)
startTestResponse_job :: Lens' StartTestResponse (Maybe Job)
startTestResponse_job = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartTestResponse' {Maybe Job
job :: Maybe Job
$sel:job:StartTestResponse' :: StartTestResponse -> Maybe Job
job} -> Maybe Job
job) (\s :: StartTestResponse
s@StartTestResponse' {} Maybe Job
a -> StartTestResponse
s {$sel:job:StartTestResponse' :: Maybe Job
job = Maybe Job
a} :: StartTestResponse)

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

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