{-# 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.Backup.GetBackupPlanFromTemplate
-- 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 template specified by its @templateId@ as a backup plan.
module Amazonka.Backup.GetBackupPlanFromTemplate
  ( -- * Creating a Request
    GetBackupPlanFromTemplate (..),
    newGetBackupPlanFromTemplate,

    -- * Request Lenses
    getBackupPlanFromTemplate_backupPlanTemplateId,

    -- * Destructuring the Response
    GetBackupPlanFromTemplateResponse (..),
    newGetBackupPlanFromTemplateResponse,

    -- * Response Lenses
    getBackupPlanFromTemplateResponse_backupPlanDocument,
    getBackupPlanFromTemplateResponse_httpStatus,
  )
where

import Amazonka.Backup.Types
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

-- | /See:/ 'newGetBackupPlanFromTemplate' smart constructor.
data GetBackupPlanFromTemplate = GetBackupPlanFromTemplate'
  { -- | Uniquely identifies a stored backup plan template.
    GetBackupPlanFromTemplate -> Text
backupPlanTemplateId :: Prelude.Text
  }
  deriving (GetBackupPlanFromTemplate -> GetBackupPlanFromTemplate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetBackupPlanFromTemplate -> GetBackupPlanFromTemplate -> Bool
$c/= :: GetBackupPlanFromTemplate -> GetBackupPlanFromTemplate -> Bool
== :: GetBackupPlanFromTemplate -> GetBackupPlanFromTemplate -> Bool
$c== :: GetBackupPlanFromTemplate -> GetBackupPlanFromTemplate -> Bool
Prelude.Eq, ReadPrec [GetBackupPlanFromTemplate]
ReadPrec GetBackupPlanFromTemplate
Int -> ReadS GetBackupPlanFromTemplate
ReadS [GetBackupPlanFromTemplate]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetBackupPlanFromTemplate]
$creadListPrec :: ReadPrec [GetBackupPlanFromTemplate]
readPrec :: ReadPrec GetBackupPlanFromTemplate
$creadPrec :: ReadPrec GetBackupPlanFromTemplate
readList :: ReadS [GetBackupPlanFromTemplate]
$creadList :: ReadS [GetBackupPlanFromTemplate]
readsPrec :: Int -> ReadS GetBackupPlanFromTemplate
$creadsPrec :: Int -> ReadS GetBackupPlanFromTemplate
Prelude.Read, Int -> GetBackupPlanFromTemplate -> ShowS
[GetBackupPlanFromTemplate] -> ShowS
GetBackupPlanFromTemplate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetBackupPlanFromTemplate] -> ShowS
$cshowList :: [GetBackupPlanFromTemplate] -> ShowS
show :: GetBackupPlanFromTemplate -> String
$cshow :: GetBackupPlanFromTemplate -> String
showsPrec :: Int -> GetBackupPlanFromTemplate -> ShowS
$cshowsPrec :: Int -> GetBackupPlanFromTemplate -> ShowS
Prelude.Show, forall x.
Rep GetBackupPlanFromTemplate x -> GetBackupPlanFromTemplate
forall x.
GetBackupPlanFromTemplate -> Rep GetBackupPlanFromTemplate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetBackupPlanFromTemplate x -> GetBackupPlanFromTemplate
$cfrom :: forall x.
GetBackupPlanFromTemplate -> Rep GetBackupPlanFromTemplate x
Prelude.Generic)

-- |
-- Create a value of 'GetBackupPlanFromTemplate' 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:
--
-- 'backupPlanTemplateId', 'getBackupPlanFromTemplate_backupPlanTemplateId' - Uniquely identifies a stored backup plan template.
newGetBackupPlanFromTemplate ::
  -- | 'backupPlanTemplateId'
  Prelude.Text ->
  GetBackupPlanFromTemplate
newGetBackupPlanFromTemplate :: Text -> GetBackupPlanFromTemplate
newGetBackupPlanFromTemplate Text
pBackupPlanTemplateId_ =
  GetBackupPlanFromTemplate'
    { $sel:backupPlanTemplateId:GetBackupPlanFromTemplate' :: Text
backupPlanTemplateId =
        Text
pBackupPlanTemplateId_
    }

-- | Uniquely identifies a stored backup plan template.
getBackupPlanFromTemplate_backupPlanTemplateId :: Lens.Lens' GetBackupPlanFromTemplate Prelude.Text
getBackupPlanFromTemplate_backupPlanTemplateId :: Lens' GetBackupPlanFromTemplate Text
getBackupPlanFromTemplate_backupPlanTemplateId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBackupPlanFromTemplate' {Text
backupPlanTemplateId :: Text
$sel:backupPlanTemplateId:GetBackupPlanFromTemplate' :: GetBackupPlanFromTemplate -> Text
backupPlanTemplateId} -> Text
backupPlanTemplateId) (\s :: GetBackupPlanFromTemplate
s@GetBackupPlanFromTemplate' {} Text
a -> GetBackupPlanFromTemplate
s {$sel:backupPlanTemplateId:GetBackupPlanFromTemplate' :: Text
backupPlanTemplateId = Text
a} :: GetBackupPlanFromTemplate)

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

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

instance Data.ToHeaders GetBackupPlanFromTemplate where
  toHeaders :: GetBackupPlanFromTemplate -> 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 GetBackupPlanFromTemplate where
  toPath :: GetBackupPlanFromTemplate -> ByteString
toPath GetBackupPlanFromTemplate' {Text
backupPlanTemplateId :: Text
$sel:backupPlanTemplateId:GetBackupPlanFromTemplate' :: GetBackupPlanFromTemplate -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/backup/template/plans/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
backupPlanTemplateId,
        ByteString
"/toPlan"
      ]

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

-- | /See:/ 'newGetBackupPlanFromTemplateResponse' smart constructor.
data GetBackupPlanFromTemplateResponse = GetBackupPlanFromTemplateResponse'
  { -- | Returns the body of a backup plan based on the target template,
    -- including the name, rules, and backup vault of the plan.
    GetBackupPlanFromTemplateResponse -> Maybe BackupPlan
backupPlanDocument :: Prelude.Maybe BackupPlan,
    -- | The response's http status code.
    GetBackupPlanFromTemplateResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetBackupPlanFromTemplateResponse
-> GetBackupPlanFromTemplateResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetBackupPlanFromTemplateResponse
-> GetBackupPlanFromTemplateResponse -> Bool
$c/= :: GetBackupPlanFromTemplateResponse
-> GetBackupPlanFromTemplateResponse -> Bool
== :: GetBackupPlanFromTemplateResponse
-> GetBackupPlanFromTemplateResponse -> Bool
$c== :: GetBackupPlanFromTemplateResponse
-> GetBackupPlanFromTemplateResponse -> Bool
Prelude.Eq, Int -> GetBackupPlanFromTemplateResponse -> ShowS
[GetBackupPlanFromTemplateResponse] -> ShowS
GetBackupPlanFromTemplateResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetBackupPlanFromTemplateResponse] -> ShowS
$cshowList :: [GetBackupPlanFromTemplateResponse] -> ShowS
show :: GetBackupPlanFromTemplateResponse -> String
$cshow :: GetBackupPlanFromTemplateResponse -> String
showsPrec :: Int -> GetBackupPlanFromTemplateResponse -> ShowS
$cshowsPrec :: Int -> GetBackupPlanFromTemplateResponse -> ShowS
Prelude.Show, forall x.
Rep GetBackupPlanFromTemplateResponse x
-> GetBackupPlanFromTemplateResponse
forall x.
GetBackupPlanFromTemplateResponse
-> Rep GetBackupPlanFromTemplateResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetBackupPlanFromTemplateResponse x
-> GetBackupPlanFromTemplateResponse
$cfrom :: forall x.
GetBackupPlanFromTemplateResponse
-> Rep GetBackupPlanFromTemplateResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetBackupPlanFromTemplateResponse' 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:
--
-- 'backupPlanDocument', 'getBackupPlanFromTemplateResponse_backupPlanDocument' - Returns the body of a backup plan based on the target template,
-- including the name, rules, and backup vault of the plan.
--
-- 'httpStatus', 'getBackupPlanFromTemplateResponse_httpStatus' - The response's http status code.
newGetBackupPlanFromTemplateResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetBackupPlanFromTemplateResponse
newGetBackupPlanFromTemplateResponse :: Int -> GetBackupPlanFromTemplateResponse
newGetBackupPlanFromTemplateResponse Int
pHttpStatus_ =
  GetBackupPlanFromTemplateResponse'
    { $sel:backupPlanDocument:GetBackupPlanFromTemplateResponse' :: Maybe BackupPlan
backupPlanDocument =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetBackupPlanFromTemplateResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Returns the body of a backup plan based on the target template,
-- including the name, rules, and backup vault of the plan.
getBackupPlanFromTemplateResponse_backupPlanDocument :: Lens.Lens' GetBackupPlanFromTemplateResponse (Prelude.Maybe BackupPlan)
getBackupPlanFromTemplateResponse_backupPlanDocument :: Lens' GetBackupPlanFromTemplateResponse (Maybe BackupPlan)
getBackupPlanFromTemplateResponse_backupPlanDocument = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBackupPlanFromTemplateResponse' {Maybe BackupPlan
backupPlanDocument :: Maybe BackupPlan
$sel:backupPlanDocument:GetBackupPlanFromTemplateResponse' :: GetBackupPlanFromTemplateResponse -> Maybe BackupPlan
backupPlanDocument} -> Maybe BackupPlan
backupPlanDocument) (\s :: GetBackupPlanFromTemplateResponse
s@GetBackupPlanFromTemplateResponse' {} Maybe BackupPlan
a -> GetBackupPlanFromTemplateResponse
s {$sel:backupPlanDocument:GetBackupPlanFromTemplateResponse' :: Maybe BackupPlan
backupPlanDocument = Maybe BackupPlan
a} :: GetBackupPlanFromTemplateResponse)

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

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