{-# 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.DrS.StartRecovery
-- 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 Recovery Instances for the specified Source Servers. For each
-- Source Server you may choose a point in time snapshot to launch from, or
-- use an on demand snapshot.
module Amazonka.DrS.StartRecovery
  ( -- * Creating a Request
    StartRecovery (..),
    newStartRecovery,

    -- * Request Lenses
    startRecovery_isDrill,
    startRecovery_tags,
    startRecovery_sourceServers,

    -- * Destructuring the Response
    StartRecoveryResponse (..),
    newStartRecoveryResponse,

    -- * Response Lenses
    startRecoveryResponse_job,
    startRecoveryResponse_httpStatus,
  )
where

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

-- | /See:/ 'newStartRecovery' smart constructor.
data StartRecovery = StartRecovery'
  { -- | Whether this Source Server Recovery operation is a drill or not.
    StartRecovery -> Maybe Bool
isDrill :: Prelude.Maybe Prelude.Bool,
    -- | The tags to be associated with the Recovery Job.
    StartRecovery -> Maybe (Sensitive (HashMap Text Text))
tags :: Prelude.Maybe (Data.Sensitive (Prelude.HashMap Prelude.Text Prelude.Text)),
    -- | The Source Servers that we want to start a Recovery Job for.
    StartRecovery -> NonEmpty StartRecoveryRequestSourceServer
sourceServers :: Prelude.NonEmpty StartRecoveryRequestSourceServer
  }
  deriving (StartRecovery -> StartRecovery -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartRecovery -> StartRecovery -> Bool
$c/= :: StartRecovery -> StartRecovery -> Bool
== :: StartRecovery -> StartRecovery -> Bool
$c== :: StartRecovery -> StartRecovery -> Bool
Prelude.Eq, Int -> StartRecovery -> ShowS
[StartRecovery] -> ShowS
StartRecovery -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartRecovery] -> ShowS
$cshowList :: [StartRecovery] -> ShowS
show :: StartRecovery -> String
$cshow :: StartRecovery -> String
showsPrec :: Int -> StartRecovery -> ShowS
$cshowsPrec :: Int -> StartRecovery -> ShowS
Prelude.Show, forall x. Rep StartRecovery x -> StartRecovery
forall x. StartRecovery -> Rep StartRecovery x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartRecovery x -> StartRecovery
$cfrom :: forall x. StartRecovery -> Rep StartRecovery x
Prelude.Generic)

-- |
-- Create a value of 'StartRecovery' 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:
--
-- 'isDrill', 'startRecovery_isDrill' - Whether this Source Server Recovery operation is a drill or not.
--
-- 'tags', 'startRecovery_tags' - The tags to be associated with the Recovery Job.
--
-- 'sourceServers', 'startRecovery_sourceServers' - The Source Servers that we want to start a Recovery Job for.
newStartRecovery ::
  -- | 'sourceServers'
  Prelude.NonEmpty StartRecoveryRequestSourceServer ->
  StartRecovery
newStartRecovery :: NonEmpty StartRecoveryRequestSourceServer -> StartRecovery
newStartRecovery NonEmpty StartRecoveryRequestSourceServer
pSourceServers_ =
  StartRecovery'
    { $sel:isDrill:StartRecovery' :: Maybe Bool
isDrill = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:StartRecovery' :: Maybe (Sensitive (HashMap Text Text))
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:sourceServers:StartRecovery' :: NonEmpty StartRecoveryRequestSourceServer
sourceServers = 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 StartRecoveryRequestSourceServer
pSourceServers_
    }

-- | Whether this Source Server Recovery operation is a drill or not.
startRecovery_isDrill :: Lens.Lens' StartRecovery (Prelude.Maybe Prelude.Bool)
startRecovery_isDrill :: Lens' StartRecovery (Maybe Bool)
startRecovery_isDrill = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartRecovery' {Maybe Bool
isDrill :: Maybe Bool
$sel:isDrill:StartRecovery' :: StartRecovery -> Maybe Bool
isDrill} -> Maybe Bool
isDrill) (\s :: StartRecovery
s@StartRecovery' {} Maybe Bool
a -> StartRecovery
s {$sel:isDrill:StartRecovery' :: Maybe Bool
isDrill = Maybe Bool
a} :: StartRecovery)

-- | The tags to be associated with the Recovery Job.
startRecovery_tags :: Lens.Lens' StartRecovery (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
startRecovery_tags :: Lens' StartRecovery (Maybe (HashMap Text Text))
startRecovery_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartRecovery' {Maybe (Sensitive (HashMap Text Text))
tags :: Maybe (Sensitive (HashMap Text Text))
$sel:tags:StartRecovery' :: StartRecovery -> Maybe (Sensitive (HashMap Text Text))
tags} -> Maybe (Sensitive (HashMap Text Text))
tags) (\s :: StartRecovery
s@StartRecovery' {} Maybe (Sensitive (HashMap Text Text))
a -> StartRecovery
s {$sel:tags:StartRecovery' :: Maybe (Sensitive (HashMap Text Text))
tags = Maybe (Sensitive (HashMap Text Text))
a} :: StartRecovery) 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)

-- | The Source Servers that we want to start a Recovery Job for.
startRecovery_sourceServers :: Lens.Lens' StartRecovery (Prelude.NonEmpty StartRecoveryRequestSourceServer)
startRecovery_sourceServers :: Lens' StartRecovery (NonEmpty StartRecoveryRequestSourceServer)
startRecovery_sourceServers = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartRecovery' {NonEmpty StartRecoveryRequestSourceServer
sourceServers :: NonEmpty StartRecoveryRequestSourceServer
$sel:sourceServers:StartRecovery' :: StartRecovery -> NonEmpty StartRecoveryRequestSourceServer
sourceServers} -> NonEmpty StartRecoveryRequestSourceServer
sourceServers) (\s :: StartRecovery
s@StartRecovery' {} NonEmpty StartRecoveryRequestSourceServer
a -> StartRecovery
s {$sel:sourceServers:StartRecovery' :: NonEmpty StartRecoveryRequestSourceServer
sourceServers = NonEmpty StartRecoveryRequestSourceServer
a} :: StartRecovery) 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 StartRecovery where
  type
    AWSResponse StartRecovery =
      StartRecoveryResponse
  request :: (Service -> Service) -> StartRecovery -> Request StartRecovery
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 StartRecovery
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse StartRecovery)))
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 -> StartRecoveryResponse
StartRecoveryResponse'
            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 StartRecovery where
  hashWithSalt :: Int -> StartRecovery -> Int
hashWithSalt Int
_salt StartRecovery' {Maybe Bool
Maybe (Sensitive (HashMap Text Text))
NonEmpty StartRecoveryRequestSourceServer
sourceServers :: NonEmpty StartRecoveryRequestSourceServer
tags :: Maybe (Sensitive (HashMap Text Text))
isDrill :: Maybe Bool
$sel:sourceServers:StartRecovery' :: StartRecovery -> NonEmpty StartRecoveryRequestSourceServer
$sel:tags:StartRecovery' :: StartRecovery -> Maybe (Sensitive (HashMap Text Text))
$sel:isDrill:StartRecovery' :: StartRecovery -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
isDrill
      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 StartRecoveryRequestSourceServer
sourceServers

instance Prelude.NFData StartRecovery where
  rnf :: StartRecovery -> ()
rnf StartRecovery' {Maybe Bool
Maybe (Sensitive (HashMap Text Text))
NonEmpty StartRecoveryRequestSourceServer
sourceServers :: NonEmpty StartRecoveryRequestSourceServer
tags :: Maybe (Sensitive (HashMap Text Text))
isDrill :: Maybe Bool
$sel:sourceServers:StartRecovery' :: StartRecovery -> NonEmpty StartRecoveryRequestSourceServer
$sel:tags:StartRecovery' :: StartRecovery -> Maybe (Sensitive (HashMap Text Text))
$sel:isDrill:StartRecovery' :: StartRecovery -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
isDrill
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 StartRecoveryRequestSourceServer
sourceServers

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

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

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

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

-- |
-- Create a value of 'StartRecoveryResponse' 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', 'startRecoveryResponse_job' - The Recovery Job.
--
-- 'httpStatus', 'startRecoveryResponse_httpStatus' - The response's http status code.
newStartRecoveryResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  StartRecoveryResponse
newStartRecoveryResponse :: Int -> StartRecoveryResponse
newStartRecoveryResponse Int
pHttpStatus_ =
  StartRecoveryResponse'
    { $sel:job:StartRecoveryResponse' :: Maybe Job
job = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:StartRecoveryResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Recovery Job.
startRecoveryResponse_job :: Lens.Lens' StartRecoveryResponse (Prelude.Maybe Job)
startRecoveryResponse_job :: Lens' StartRecoveryResponse (Maybe Job)
startRecoveryResponse_job = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartRecoveryResponse' {Maybe Job
job :: Maybe Job
$sel:job:StartRecoveryResponse' :: StartRecoveryResponse -> Maybe Job
job} -> Maybe Job
job) (\s :: StartRecoveryResponse
s@StartRecoveryResponse' {} Maybe Job
a -> StartRecoveryResponse
s {$sel:job:StartRecoveryResponse' :: Maybe Job
job = Maybe Job
a} :: StartRecoveryResponse)

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

instance Prelude.NFData StartRecoveryResponse where
  rnf :: StartRecoveryResponse -> ()
rnf StartRecoveryResponse' {Int
Maybe Job
httpStatus :: Int
job :: Maybe Job
$sel:httpStatus:StartRecoveryResponse' :: StartRecoveryResponse -> Int
$sel:job:StartRecoveryResponse' :: StartRecoveryResponse -> 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